GNU bug report logs - #74900
[PATCH] Replace (guix build json) with (json) in node build system

Previous Next

Package: guix-patches;

Reported by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>

Date: Sun, 15 Dec 2024 20:31:01 UTC

Severity: normal

Tags: patch

Done: Jelle Licht <jlicht <at> fsfe.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 74900 in the body.
You can then email your comments to 74900 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sun, 15 Dec 2024 20:31:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Sun, 15 Dec 2024 20:31:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: guix-patches <at> gnu.org
Subject: [PATCH] Replace (guix build json) with (json) in node build system
Date: Sun, 15 Dec 2024 20:30:16 +0000
[Message part 1 (text/plain, inline)]
This change replaces the use of (guix build json) with (json) for the
node ecosystem.
Since guile-json is a dependency of Guix, and it's used elsewhere in
the project, it makes sense to use this instead of rolling our own
JSON implementation with (guix build json).
This is one step to move away from (guix build json), there will be
other changes to remove the other uses of it.

I tested it out by building the 4 affected node-xyz packages and
verified that the modified package.json was correct for node-acorn and
node-addon-api.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I0c86b3039eb2f50a19f9d9650f5a73b3a473ad37
---
 gnu/packages/node-xyz.scm        | 148 ++++++++++++--------------
 guix/build-system/node.scm       |   6 +-
 guix/build/node-build-system.scm | 176 +++++++++++--------------------
 3 files changed, 135 insertions(+), 195 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index cf6f50e3ce..decfb50a66 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Dhruvin Gandhi <contact <at> dhruvin.dev>
 ;;; Copyright © 2022 Nicolas Graves <ngraves <at> ngraves.fr>
 ;;; Copyright © 2023 Jelle Licht <jlicht <at> fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,14 +25,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu packages node-xyz)
-  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (gnu packages sqlite)
   #:use-module (gnu packages python)
   #:use-module (gnu packages web)
+  #:use-module (guix build-system node)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix git-download)
-  #:use-module (guix build-system node))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix packages))

 ;;;
 ;;; Please: Try to add new module packages in alphabetic order.
@@ -69,19 +70,17 @@ (define-public node-acorn
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
              ;; TODO: Add utility function
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("prepare" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other other))
-                                pkg-meta-alist)))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("prepare" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist)))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -156,23 +155,17 @@ (define-public node-addon-api
            (lambda args
              (define new-test-script
                "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons
-                   '@
-                   (map (match-lambda
-                          (("scripts" '@ . scripts-alist)
-                           `("scripts" @ ,@(map (match-lambda
-                                                  (("test" . _)
-                                                   (cons "test"
-                                                         new-test-script))
-                                                  (other
-                                                   other))
-                                                scripts-alist)))
-                          (other
-                           other))
-                        pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (map
+                       (match-lambda
+                         (("test" . _) (cons "test" new-test-script))
+                         (other other))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -1221,22 +1214,19 @@ (define-public node-serialport-bindings
                                     "node-abi"))))
          (add-after 'chdir 'avoid-prebuild-install
            (lambda args
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (("gypfile" . _)
-                                   '("gypfile" . #f))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (("gypfile" . _)
+                     (cons "gypfile" #f))
+                   (other other))
+                 pkg-meta-alist))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1522,39 +1512,33 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (match (assoc-ref pkg-meta-alist "binary")
-                    (('@ . binary-alist)
-                     ;; When it builds from source, node-pre-gyp supplies
-                     ;; module_name and module_path based on the entries under
-                     ;; "binary" from "package.json", so this package's
-                     ;; "binding.gyp" doesn't define them. Thus, we also need
-                     ;; to supply them. The GYP_DEFINES environment variable
-                     ;; turns out to be the easiest way to make sure they are
-                     ;; propagated from npm to node-gyp to gyp.
-                     (setenv "GYP_DEFINES"
-                             (string-append
-                              "module_name="
-                              (assoc-ref binary-alist "module_name")
-                              " "
-                              "module_path="
-                              (assoc-ref binary-alist "module_path")))))
-                  ;; We need to remove the install script from "package.json",
-                  ;; as it would try to use node-pre-gyp and would block the
-                  ;; automatic building performed by `npm install`.
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+                 ;; When it builds from source, node-pre-gyp supplies
+                 ;; module_name and module_path based on the entries under
+                 ;; "binary" from "package.json", so this package's
+                 ;; "binding.gyp" doesn't define them. Thus, we also need
+                 ;; to supply them. The GYP_DEFINES environment variable
+                 ;; turns out to be the easiest way to make sure they are
+                 ;; propagated from npm to node-gyp to gyp.
+                 (setenv "GYP_DEFINES" (string-append
+                   "module_name="
+                   (assoc-ref binary-alist "module_name")
+                   " module_path="
+                   (assoc-ref binary-alist "module_path"))))
+               ;; We need to remove the install script from "package.json",
+               ;; as it would try to use node-pre-gyp and would block the
+               ;; automatic building performed by `npm install`.
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 57fe5f6030..425b8cd9b3 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
 ;;; Copyright © 2021 Philip McGrath <philip <at> philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,10 @@ (define-module (guix build-system node)
 (define %node-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build node-build-system)
-    (guix build json)
+    (json)
+    (json builder)
+    (json parser)
+    (json record)
     ,@%default-gnu-imported-modules))

 (define (default-node)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index fb23894bc1..ef0f88a5a7 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019, 2021 Timothy Sample <samplet <at> ngyro.com>
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler <at> gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,10 +24,10 @@
 (define-module (guix build node-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
-  #:use-module (guix build json)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
@@ -34,13 +35,13 @@ (define-module (guix build node-build-system)
             delete-dependencies
             node-build))

-(define (with-atomic-json-file-replacement file proc)
+(define* (with-atomic-json-file-replacement proc #:optional (file
"package.json"))
   "Like 'with-atomic-file-replacement', but PROC is called with a single
 argument---the result of parsing FILE's contents as json---and should a value
 to be written as json to the replacement FILE."
   (with-atomic-file-replacement file
     (lambda (in out)
-      (write-json (proc (read-json in)) out))))
+      (scm->json (proc (json->scm in)) out))))

 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -48,10 +49,6 @@ (define* (assoc-ref* alist key #:optional default)
     (#f default)
     ((_ . value) value)))

-(define* (jsobject-ref obj key #:optional default)
-  (match obj
-    (('@ . alist) (assoc-ref* alist key default))))
-
 (define* (alist-pop alist key #:optional (= equal?))
   "Return two values, the first pair in ALIST with key KEY, and the other
 elements.  Equality calls are made as (= KEY ALISTCAR)."
@@ -63,67 +60,17 @@ (define* (alist-pop alist key #:optional (= equal?))
         (values (car after) (append before (cdr after)))
         (values #f before))))

-(define* (alist-update alist key proc #:optional default (= equal?))
+(define* (alist-update alist key proc #:optional (= equal?))
   "Return an association list like ALIST, but with KEY mapped to the result of
 PROC applied to the first value found under the comparison (= KEY ALISTCAR).
-If no such value exists, use DEFAULT instead.
+If no such value exists, return the list unchanged.
 Unlike acons, this removes the previous association of KEY (assuming it is
 unique), but the result may still share storage with ALIST."
   (let ((pair rest (alist-pop alist key =)))
-    (acons key
-           (proc (if (pair? pair)
-                     (cdr pair)
-                     default))
-           rest)))
-
-(define (jsobject-update* js . updates)
-  "Return a json object like JS, but with all UPDATES applied.  Each update is
-a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of PROC
-applied to the value to which KEY is mapped in JS.  If no such mapping exists,
-PROC is instead applied to DEFAULT, or to '#f' is no DEFAULT is specified.
-The update takes place from left to right, so later UPDATERs will receive the
-values returned by earlier UPDATERs for the same KEY."
-  (match js
-    (('@ . alist)
-     (let loop ((alist alist)
-                (updates updates))
-       (match updates
-         (() (cons '@ alist))
-         (((key proc) . updates)
-          (loop (alist-update alist key proc #f equal?) updates))
-         (((key proc default) . updates)
-          (loop (alist-update alist key proc default equal?) updates)))))))
-
-(define (jsobject-union combine seed . objects)
-  "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0
-is the value found in the (possibly updated) SEED and VAL is the new value
-found in one of the OBJECTS."
-  (match seed
-    (('@ . aseed)
-     (match objects
-       (() seed)
-       ((('@ . alists) ...)
-        (cons
-         '@
-         (fold (lambda (alist aseed)
-                 (if (null? aseed) alist
-                     (fold
-                      (match-lambda*
-                        (((k . v) aseed)
-                         (let ((pair tail (alist-pop alist k)))
-                           (match pair
-                             (#f (acons k v aseed))
-                             ((_ . v0) (acons k (combine k v0 v) aseed))))))
-                      aseed
-                      alist)))
-               aseed
-               alists)))))))
+    (if (pair? pair)
+      (acons key (proc (cdr pair)) rest)
+      alist)))

-;; Possibly useful helper functions:
-;; (define (newest key val0 val) val)
-;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val)))
-
-
 ;;;
 ;;; Phases.
 ;;;
@@ -142,8 +89,8 @@ (define (set-home . _)

 (define (module-name module)
   (let* ((package.json (string-append module "/package.json"))
-         (package-meta (call-with-input-file package.json read-json)))
-    (jsobject-ref package-meta "name")))
+         (package-meta (call-with-input-file package.json json->scm)))
+    (assoc-ref package-meta "name")))

 (define (index-modules input-paths)
   (define (list-modules directory)
@@ -167,49 +114,56 @@ (define* (patch-dependencies #:key inputs
#:allow-other-keys)

   (define index (index-modules (map cdr inputs)))

-  (define resolve-dependencies
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (map (match-lambda
-                       ((key . value)
-                        (cons key (hash-ref index key value))))
-                     alist)))))
+  (define (resolve-dependencies dependencies)
+    (map
+      (match-lambda
+        ((dependency . version)
+          (cons dependency (hash-ref index dependency version))))
+      dependencies))

-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,resolve-dependencies (@))
-       `("dependencies" ,(lambda (deps)
-                           (resolve-dependencies
-                            (jsobject-union
-                             (lambda (k a b) b)
-                             (jsobject-ref pkg-meta "peerDependencies" '(@))
-                             deps)))
-         (@)))))
+      (fold
+        (lambda (proc pkg-meta) (proc pkg-meta))
+        pkg-meta
+        (list
+          (lambda (pkg-meta)
+            (alist-update pkg-meta "devDependencies" resolve-dependencies))
+          (lambda (pkg-meta)
+            (assoc-set!
+              pkg-meta
+              "dependencies"
+              (resolve-dependencies
+                ; Combined "peerDependencies" and "dependencies" dependencies
+                ; with "dependencies" taking precedent.
+                (fold
+                  (lambda (dependency dependencies)
+                    (assoc-set! dependencies (car dependency) (cdr
dependency)))
+                  (assoc-ref* pkg-meta "peerDependencies" '())
+                  (assoc-ref* pkg-meta "dependencies" '())
+                ))))))))
   #t)

-(define (delete-dependencies absent)
+(define (delete-dependencies dependencies-to-remove)
   "Rewrite 'package.json' to allow the build to proceed without packages
-listed in ABSENT, a list of strings naming npm packages.
+listed in 'dependencies-to-remove', a list of strings naming npm packages.

 To prevent the deleted dependencies from being reintroduced, use this function
 only after the 'patch-dependencies' phase."
-  (define delete-from-jsobject
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (filter (match-lambda
-                          ((k . _)
-                           (not (member k absent))))
-                        alist)))))
-
-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,delete-from-jsobject (@))
-       `("dependencies" ,delete-from-jsobject (@))
-       `("peerDependencies" ,delete-from-jsobject (@))))))
+      (fold
+        (lambda (dependency-key pkg-meta)
+          (alist-update
+            pkg-meta
+            dependency-key
+            (lambda (dependencies)
+              (remove
+                (lambda (dependency)
+                  (member (car dependency) dependencies-to-remove))
+                dependencies))))
+        pkg-meta
+        (list "devDependencies" "dependencies" "peerDependencies"
"optionalDependencies")))))

 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
@@ -228,8 +182,8 @@ (define* (configure #:key outputs inputs #:allow-other-keys)
     #t))

 (define* (build #:key inputs #:allow-other-keys)
-  (let ((package-meta (call-with-input-file "package.json" read-json)))
-    (if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f)
+  (let ((package-meta (call-with-input-file "package.json" json->scm)))
+    (if (assoc-ref* (assoc-ref* package-meta "scripts" '()) "build" #f)
         (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
           (invoke npm "run" "build"))
         (format #t "there is no build script to run~%"))
@@ -301,22 +255,20 @@ (define* (avoid-node-gyp-rebuild #:key outputs
#:allow-other-keys)
   ;; even need to overwrite this file.  Therefore, let's use some helpers
   ;; that we'd otherwise not need.
   (define pkg-meta
-    (call-with-input-file installed-package.json read-json))
+    (call-with-input-file installed-package.json json->scm))
   (define scripts
-    (jsobject-ref pkg-meta "scripts" '(@)))
-  (define (jsobject-set js key val)
-    (jsobject-update* js (list key (const val))))
+    (assoc-ref* pkg-meta "scripts" '()))

-  (when (equal? "node-gyp rebuild" (jsobject-ref scripts "install" #f))
+  (when (equal? "node-gyp rebuild" (assoc-ref* scripts "install" #f))
     (call-with-output-file installed-package.json
       (lambda (out)
-        (write-json
-         (jsobject-set pkg-meta
-                       "scripts"
-                       (jsobject-set scripts
-                                     "install"
-                                     "echo Guix: avoiding node-gyp rebuild"))
-         out)))))
+        (scm->json
+          (assoc-set! pkg-meta
+                      "scripts"
+                      (assoc-set! scripts
+                                  "install"
+                                  "echo Guix: avoiding node-gyp rebuild"))
+          out)))))

 (define %standard-phases
   (modify-phases gnu:%standard-phases

base-commit: cfd4f56f75a20b6732d463180d211f796c9032e5
-- 
2.46.0
[0001-Replace-guix-build-json-with-json-in-node-build-syst.patch (text/x-patch, attachment)]

Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sun, 15 Dec 2024 21:44:02 GMT) Full text and rfc822 format available.

Message #8 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Date: Sun, 15 Dec 2024 21:41:44 +0000
[Message part 1 (text/plain, inline)]
Sorry went over the line width limit in my diff below, here it is again:

This change replaces the use of (guix build json) with (json) for the
node ecosystem.
Since guile-json is a dependency of Guix, and it's used elsewhere in
the project, it makes sense to use this instead of rolling our own
JSON implementation with (guix build json).
This is one step to move away from (guix build json), there will be
other changes to remove the other uses of it.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I0c86b3039eb2f50a19f9d9650f5a73b3a473ad37
---
 gnu/packages/node-xyz.scm        | 148 +++++++++++--------------
 guix/build-system/node.scm       |   6 +-
 guix/build/node-build-system.scm | 181 ++++++++++++-------------------
 3 files changed, 140 insertions(+), 195 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index cf6f50e3ce..decfb50a66 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Dhruvin Gandhi <contact <at> dhruvin.dev>
 ;;; Copyright © 2022 Nicolas Graves <ngraves <at> ngraves.fr>
 ;;; Copyright © 2023 Jelle Licht <jlicht <at> fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,14 +25,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu packages node-xyz)
-  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (gnu packages sqlite)
   #:use-module (gnu packages python)
   #:use-module (gnu packages web)
+  #:use-module (guix build-system node)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix git-download)
-  #:use-module (guix build-system node))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix packages))

 ;;;
 ;;; Please: Try to add new module packages in alphabetic order.
@@ -69,19 +70,17 @@ (define-public node-acorn
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
              ;; TODO: Add utility function
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("prepare" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other other))
-                                pkg-meta-alist)))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("prepare" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist)))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -156,23 +155,17 @@ (define-public node-addon-api
            (lambda args
              (define new-test-script
                "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons
-                   '@
-                   (map (match-lambda
-                          (("scripts" '@ . scripts-alist)
-                           `("scripts" @ ,@(map (match-lambda
-                                                  (("test" . _)
-                                                   (cons "test"
-                                                         new-test-script))
-                                                  (other
-                                                   other))
-                                                scripts-alist)))
-                          (other
-                           other))
-                        pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (map
+                       (match-lambda
+                         (("test" . _) (cons "test" new-test-script))
+                         (other other))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -1221,22 +1214,19 @@ (define-public node-serialport-bindings
                                     "node-abi"))))
          (add-after 'chdir 'avoid-prebuild-install
            (lambda args
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (("gypfile" . _)
-                                   '("gypfile" . #f))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (("gypfile" . _)
+                     (cons "gypfile" #f))
+                   (other other))
+                 pkg-meta-alist))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1522,39 +1512,33 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (match (assoc-ref pkg-meta-alist "binary")
-                    (('@ . binary-alist)
-                     ;; When it builds from source, node-pre-gyp supplies
-                     ;; module_name and module_path based on the entries under
-                     ;; "binary" from "package.json", so this package's
-                     ;; "binding.gyp" doesn't define them. Thus, we also need
-                     ;; to supply them. The GYP_DEFINES environment variable
-                     ;; turns out to be the easiest way to make sure they are
-                     ;; propagated from npm to node-gyp to gyp.
-                     (setenv "GYP_DEFINES"
-                             (string-append
-                              "module_name="
-                              (assoc-ref binary-alist "module_name")
-                              " "
-                              "module_path="
-                              (assoc-ref binary-alist "module_path")))))
-                  ;; We need to remove the install script from "package.json",
-                  ;; as it would try to use node-pre-gyp and would block the
-                  ;; automatic building performed by `npm install`.
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+                 ;; When it builds from source, node-pre-gyp supplies
+                 ;; module_name and module_path based on the entries under
+                 ;; "binary" from "package.json", so this package's
+                 ;; "binding.gyp" doesn't define them. Thus, we also need
+                 ;; to supply them. The GYP_DEFINES environment variable
+                 ;; turns out to be the easiest way to make sure they are
+                 ;; propagated from npm to node-gyp to gyp.
+                 (setenv "GYP_DEFINES" (string-append
+                   "module_name="
+                   (assoc-ref binary-alist "module_name")
+                   " module_path="
+                   (assoc-ref binary-alist "module_path"))))
+               ;; We need to remove the install script from "package.json",
+               ;; as it would try to use node-pre-gyp and would block the
+               ;; automatic building performed by `npm install`.
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 57fe5f6030..425b8cd9b3 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
 ;;; Copyright © 2021 Philip McGrath <philip <at> philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,10 @@ (define-module (guix build-system node)
 (define %node-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build node-build-system)
-    (guix build json)
+    (json)
+    (json builder)
+    (json parser)
+    (json record)
     ,@%default-gnu-imported-modules))

 (define (default-node)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index fb23894bc1..46e0ddd71d 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019, 2021 Timothy Sample <samplet <at> ngyro.com>
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler <at> gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,10 +24,10 @@
 (define-module (guix build node-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
-  #:use-module (guix build json)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
@@ -34,13 +35,14 @@ (define-module (guix build node-build-system)
             delete-dependencies
             node-build))

-(define (with-atomic-json-file-replacement file proc)
+(define* (with-atomic-json-file-replacement proc
+  #:optional (file "package.json"))
   "Like 'with-atomic-file-replacement', but PROC is called with a single
 argument---the result of parsing FILE's contents as json---and should a value
 to be written as json to the replacement FILE."
   (with-atomic-file-replacement file
     (lambda (in out)
-      (write-json (proc (read-json in)) out))))
+      (scm->json (proc (json->scm in)) out))))

 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -48,10 +50,6 @@ (define* (assoc-ref* alist key #:optional default)
     (#f default)
     ((_ . value) value)))

-(define* (jsobject-ref obj key #:optional default)
-  (match obj
-    (('@ . alist) (assoc-ref* alist key default))))
-
 (define* (alist-pop alist key #:optional (= equal?))
   "Return two values, the first pair in ALIST with key KEY, and the other
 elements.  Equality calls are made as (= KEY ALISTCAR)."
@@ -63,67 +61,17 @@ (define* (alist-pop alist key #:optional (= equal?))
         (values (car after) (append before (cdr after)))
         (values #f before))))

-(define* (alist-update alist key proc #:optional default (= equal?))
+(define* (alist-update alist key proc #:optional (= equal?))
   "Return an association list like ALIST, but with KEY mapped to the result of
 PROC applied to the first value found under the comparison (= KEY ALISTCAR).
-If no such value exists, use DEFAULT instead.
+If no such value exists, return the list unchanged.
 Unlike acons, this removes the previous association of KEY (assuming it is
 unique), but the result may still share storage with ALIST."
   (let ((pair rest (alist-pop alist key =)))
-    (acons key
-           (proc (if (pair? pair)
-                     (cdr pair)
-                     default))
-           rest)))
-
-(define (jsobject-update* js . updates)
-  "Return a json object like JS, but with all UPDATES applied.  Each update is
-a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of PROC
-applied to the value to which KEY is mapped in JS.  If no such mapping exists,
-PROC is instead applied to DEFAULT, or to '#f' is no DEFAULT is specified.
-The update takes place from left to right, so later UPDATERs will receive the
-values returned by earlier UPDATERs for the same KEY."
-  (match js
-    (('@ . alist)
-     (let loop ((alist alist)
-                (updates updates))
-       (match updates
-         (() (cons '@ alist))
-         (((key proc) . updates)
-          (loop (alist-update alist key proc #f equal?) updates))
-         (((key proc default) . updates)
-          (loop (alist-update alist key proc default equal?) updates)))))))
-
-(define (jsobject-union combine seed . objects)
-  "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0
-is the value found in the (possibly updated) SEED and VAL is the new value
-found in one of the OBJECTS."
-  (match seed
-    (('@ . aseed)
-     (match objects
-       (() seed)
-       ((('@ . alists) ...)
-        (cons
-         '@
-         (fold (lambda (alist aseed)
-                 (if (null? aseed) alist
-                     (fold
-                      (match-lambda*
-                        (((k . v) aseed)
-                         (let ((pair tail (alist-pop alist k)))
-                           (match pair
-                             (#f (acons k v aseed))
-                             ((_ . v0) (acons k (combine k v0 v) aseed))))))
-                      aseed
-                      alist)))
-               aseed
-               alists)))))))
+    (if (pair? pair)
+      (acons key (proc (cdr pair)) rest)
+      alist)))

-;; Possibly useful helper functions:
-;; (define (newest key val0 val) val)
-;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val)))
-
-
 ;;;
 ;;; Phases.
 ;;;
@@ -142,8 +90,8 @@ (define (set-home . _)

 (define (module-name module)
   (let* ((package.json (string-append module "/package.json"))
-         (package-meta (call-with-input-file package.json read-json)))
-    (jsobject-ref package-meta "name")))
+         (package-meta (call-with-input-file package.json json->scm)))
+    (assoc-ref package-meta "name")))

 (define (index-modules input-paths)
   (define (list-modules directory)
@@ -167,49 +115,60 @@ (define* (patch-dependencies #:key inputs
#:allow-other-keys)

   (define index (index-modules (map cdr inputs)))

-  (define resolve-dependencies
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (map (match-lambda
-                       ((key . value)
-                        (cons key (hash-ref index key value))))
-                     alist)))))
+  (define (resolve-dependencies dependencies)
+    (map
+      (match-lambda
+        ((dependency . version)
+          (cons dependency (hash-ref index dependency version))))
+      dependencies))

-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,resolve-dependencies (@))
-       `("dependencies" ,(lambda (deps)
-                           (resolve-dependencies
-                            (jsobject-union
-                             (lambda (k a b) b)
-                             (jsobject-ref pkg-meta "peerDependencies" '(@))
-                             deps)))
-         (@)))))
+      (fold
+        (lambda (proc pkg-meta) (proc pkg-meta))
+        pkg-meta
+        (list
+          (lambda (pkg-meta)
+            (alist-update pkg-meta "devDependencies" resolve-dependencies))
+          (lambda (pkg-meta)
+            (assoc-set!
+              pkg-meta
+              "dependencies"
+              (resolve-dependencies
+                ; Combined "peerDependencies" and "dependencies" dependencies
+                ; with "dependencies" taking precedent.
+                (fold
+                  (lambda (dependency dependencies)
+                    (apply assoc-set! dependencies dependency))
+                  (assoc-ref* pkg-meta "peerDependencies" '())
+                  (assoc-ref* pkg-meta "dependencies" '())
+                ))))))))
   #t)

-(define (delete-dependencies absent)
+(define (delete-dependencies dependencies-to-remove)
   "Rewrite 'package.json' to allow the build to proceed without packages
-listed in ABSENT, a list of strings naming npm packages.
+listed in 'dependencies-to-remove', a list of strings naming npm packages.

 To prevent the deleted dependencies from being reintroduced, use this function
 only after the 'patch-dependencies' phase."
-  (define delete-from-jsobject
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (filter (match-lambda
-                          ((k . _)
-                           (not (member k absent))))
-                        alist)))))
-
-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,delete-from-jsobject (@))
-       `("dependencies" ,delete-from-jsobject (@))
-       `("peerDependencies" ,delete-from-jsobject (@))))))
+      (fold
+        (lambda (dependency-key pkg-meta)
+          (alist-update
+            pkg-meta
+            dependency-key
+            (lambda (dependencies)
+              (remove
+                (lambda (dependency)
+                  (member (car dependency) dependencies-to-remove))
+                dependencies))))
+        pkg-meta
+        (list
+          "devDependencies"
+          "dependencies"
+          "peerDependencies"
+          "optionalDependencies")))))

 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
@@ -228,8 +187,8 @@ (define* (configure #:key outputs inputs #:allow-other-keys)
     #t))

 (define* (build #:key inputs #:allow-other-keys)
-  (let ((package-meta (call-with-input-file "package.json" read-json)))
-    (if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f)
+  (let ((package-meta (call-with-input-file "package.json" json->scm)))
+    (if (assoc-ref* (assoc-ref* package-meta "scripts" '()) "build" #f)
         (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
           (invoke npm "run" "build"))
         (format #t "there is no build script to run~%"))
@@ -301,22 +260,20 @@ (define* (avoid-node-gyp-rebuild #:key outputs
#:allow-other-keys)
   ;; even need to overwrite this file.  Therefore, let's use some helpers
   ;; that we'd otherwise not need.
   (define pkg-meta
-    (call-with-input-file installed-package.json read-json))
+    (call-with-input-file installed-package.json json->scm))
   (define scripts
-    (jsobject-ref pkg-meta "scripts" '(@)))
-  (define (jsobject-set js key val)
-    (jsobject-update* js (list key (const val))))
+    (assoc-ref* pkg-meta "scripts" '()))

-  (when (equal? "node-gyp rebuild" (jsobject-ref scripts "install" #f))
+  (when (equal? "node-gyp rebuild" (assoc-ref* scripts "install" #f))
     (call-with-output-file installed-package.json
       (lambda (out)
-        (write-json
-         (jsobject-set pkg-meta
-                       "scripts"
-                       (jsobject-set scripts
-                                     "install"
-                                     "echo Guix: avoiding node-gyp rebuild"))
-         out)))))
+        (scm->json
+          (assoc-set! pkg-meta
+                      "scripts"
+                      (assoc-set! scripts
+                                  "install"
+                                  "echo Guix: avoiding node-gyp rebuild"))
+          out)))))

 (define %standard-phases
   (modify-phases gnu:%standard-phases

base-commit: cfd4f56f75a20b6732d463180d211f796c9032e5
-- 
2.46.0
[0001-Replace-guix-build-json-with-json-in-node-build-syst.patch (text/x-patch, attachment)]

Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Thu, 26 Dec 2024 13:32:01 GMT) Full text and rfc822 format available.

Message #11 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Subject: Re:
Date: Thu, 26 Dec 2024 13:30:26 +0000
[Message part 1 (text/plain, inline)]
Here's the patch again but with a formatting issue fixed and a fresh
merge from master:

From 19449feab9e31590bbd7c933b21163f8b398439b Mon Sep 17 00:00:00 2001
From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Date: Thu, 26 Dec 2024 04:35:39 -0800
Subject: [PATCH] Replace (guix build json) with (json) in node build system

This change replaces the use of (guix build json) with (json) for the
node ecosystem.
Since guile-json is a dependency of Guix, and it's used elsewhere in
the project, it makes sense to use this instead of rolling our own
JSON implementation with (guix build json).
This is one step to move away from (guix build json), there will be
other changes to remove the other uses of it.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I9fd5152a98b6a241d414e9a94ab179c9cabcfb85
---
 gnu/packages/node-xyz.scm        | 148 ++++++++++++-------------
 guix/build-system/node.scm       |   6 +-
 guix/build/node-build-system.scm | 180 ++++++++++++-------------------
 3 files changed, 139 insertions(+), 195 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index e98eda2a01..ec3f9fbfb1 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Dhruvin Gandhi <contact <at> dhruvin.dev>
 ;;; Copyright © 2022 Nicolas Graves <ngraves <at> ngraves.fr>
 ;;; Copyright © 2023 Jelle Licht <jlicht <at> fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,14 +25,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu packages node-xyz)
-  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (gnu packages sqlite)
   #:use-module (gnu packages python)
   #:use-module (gnu packages web)
+  #:use-module (guix build-system node)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix git-download)
-  #:use-module (guix build-system node))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix packages))

 ;;;
 ;;; Please: Try to add new module packages in alphabetic order.
@@ -69,19 +70,17 @@ (define-public node-acorn
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
              ;; TODO: Add utility function
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("prepare" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other other))
-                                pkg-meta-alist)))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("prepare" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist)))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -158,23 +157,17 @@ (define-public node-addon-api
            (lambda args
              (define new-test-script
                "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons
-                   '@
-                   (map (match-lambda
-                          (("scripts" '@ . scripts-alist)
-                           `("scripts" @ ,@(map (match-lambda
-                                                  (("test" . _)
-                                                   (cons "test"
-                                                         new-test-script))
-                                                  (other
-                                                   other))
-                                                scripts-alist)))
-                          (other
-                           other))
-                        pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (map
+                       (match-lambda
+                         (("test" . _) (cons "test" new-test-script))
+                         (other other))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -1223,22 +1216,19 @@ (define-public node-serialport-bindings
                                     "node-abi"))))
          (add-after 'chdir 'avoid-prebuild-install
            (lambda args
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (("gypfile" . _)
-                                   '("gypfile" . #f))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (("gypfile" . _)
+                     (cons "gypfile" #f))
+                   (other other))
+                 pkg-meta-alist))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1524,39 +1514,33 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (match (assoc-ref pkg-meta-alist "binary")
-                    (('@ . binary-alist)
-                     ;; When it builds from source, node-pre-gyp supplies
-                     ;; module_name and module_path based on the entries under
-                     ;; "binary" from "package.json", so this package's
-                     ;; "binding.gyp" doesn't define them. Thus, we also need
-                     ;; to supply them. The GYP_DEFINES environment variable
-                     ;; turns out to be the easiest way to make sure they are
-                     ;; propagated from npm to node-gyp to gyp.
-                     (setenv "GYP_DEFINES"
-                             (string-append
-                              "module_name="
-                              (assoc-ref binary-alist "module_name")
-                              " "
-                              "module_path="
-                              (assoc-ref binary-alist "module_path")))))
-                  ;; We need to remove the install script from "package.json",
-                  ;; as it would try to use node-pre-gyp and would block the
-                  ;; automatic building performed by `npm install`.
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+                 ;; When it builds from source, node-pre-gyp supplies
+                 ;; module_name and module_path based on the entries under
+                 ;; "binary" from "package.json", so this package's
+                 ;; "binding.gyp" doesn't define them. Thus, we also need
+                 ;; to supply them. The GYP_DEFINES environment variable
+                 ;; turns out to be the easiest way to make sure they are
+                 ;; propagated from npm to node-gyp to gyp.
+                 (setenv "GYP_DEFINES" (string-append
+                   "module_name="
+                   (assoc-ref binary-alist "module_name")
+                   " module_path="
+                   (assoc-ref binary-alist "module_path"))))
+               ;; We need to remove the install script from "package.json",
+               ;; as it would try to use node-pre-gyp and would block the
+               ;; automatic building performed by `npm install`.
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 57fe5f6030..425b8cd9b3 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
 ;;; Copyright © 2021 Philip McGrath <philip <at> philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,10 @@ (define-module (guix build-system node)
 (define %node-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build node-build-system)
-    (guix build json)
+    (json)
+    (json builder)
+    (json parser)
+    (json record)
     ,@%default-gnu-imported-modules))

 (define (default-node)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index fb23894bc1..f95c3bd793 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019, 2021 Timothy Sample <samplet <at> ngyro.com>
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler <at> gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,10 +24,10 @@
 (define-module (guix build node-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
-  #:use-module (guix build json)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
@@ -34,13 +35,14 @@ (define-module (guix build node-build-system)
             delete-dependencies
             node-build))

-(define (with-atomic-json-file-replacement file proc)
+(define* (with-atomic-json-file-replacement proc
+  #:optional (file "package.json"))
   "Like 'with-atomic-file-replacement', but PROC is called with a single
 argument---the result of parsing FILE's contents as json---and should a value
 to be written as json to the replacement FILE."
   (with-atomic-file-replacement file
     (lambda (in out)
-      (write-json (proc (read-json in)) out))))
+      (scm->json (proc (json->scm in)) out))))

 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -48,10 +50,6 @@ (define* (assoc-ref* alist key #:optional default)
     (#f default)
     ((_ . value) value)))

-(define* (jsobject-ref obj key #:optional default)
-  (match obj
-    (('@ . alist) (assoc-ref* alist key default))))
-
 (define* (alist-pop alist key #:optional (= equal?))
   "Return two values, the first pair in ALIST with key KEY, and the other
 elements.  Equality calls are made as (= KEY ALISTCAR)."
@@ -63,67 +61,17 @@ (define* (alist-pop alist key #:optional (= equal?))
         (values (car after) (append before (cdr after)))
         (values #f before))))

-(define* (alist-update alist key proc #:optional default (= equal?))
+(define* (alist-update alist key proc #:optional (= equal?))
   "Return an association list like ALIST, but with KEY mapped to the result of
 PROC applied to the first value found under the comparison (= KEY ALISTCAR).
-If no such value exists, use DEFAULT instead.
+If no such value exists, return the list unchanged.
 Unlike acons, this removes the previous association of KEY (assuming it is
 unique), but the result may still share storage with ALIST."
   (let ((pair rest (alist-pop alist key =)))
-    (acons key
-           (proc (if (pair? pair)
-                     (cdr pair)
-                     default))
-           rest)))
-
-(define (jsobject-update* js . updates)
-  "Return a json object like JS, but with all UPDATES applied.  Each update is
-a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of PROC
-applied to the value to which KEY is mapped in JS.  If no such mapping exists,
-PROC is instead applied to DEFAULT, or to '#f' is no DEFAULT is specified.
-The update takes place from left to right, so later UPDATERs will receive the
-values returned by earlier UPDATERs for the same KEY."
-  (match js
-    (('@ . alist)
-     (let loop ((alist alist)
-                (updates updates))
-       (match updates
-         (() (cons '@ alist))
-         (((key proc) . updates)
-          (loop (alist-update alist key proc #f equal?) updates))
-         (((key proc default) . updates)
-          (loop (alist-update alist key proc default equal?) updates)))))))
-
-(define (jsobject-union combine seed . objects)
-  "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0
-is the value found in the (possibly updated) SEED and VAL is the new value
-found in one of the OBJECTS."
-  (match seed
-    (('@ . aseed)
-     (match objects
-       (() seed)
-       ((('@ . alists) ...)
-        (cons
-         '@
-         (fold (lambda (alist aseed)
-                 (if (null? aseed) alist
-                     (fold
-                      (match-lambda*
-                        (((k . v) aseed)
-                         (let ((pair tail (alist-pop alist k)))
-                           (match pair
-                             (#f (acons k v aseed))
-                             ((_ . v0) (acons k (combine k v0 v) aseed))))))
-                      aseed
-                      alist)))
-               aseed
-               alists)))))))
+    (if (pair? pair)
+      (acons key (proc (cdr pair)) rest)
+      alist)))

-;; Possibly useful helper functions:
-;; (define (newest key val0 val) val)
-;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val)))
-
-
 ;;;
 ;;; Phases.
 ;;;
@@ -142,8 +90,8 @@ (define (set-home . _)

 (define (module-name module)
   (let* ((package.json (string-append module "/package.json"))
-         (package-meta (call-with-input-file package.json read-json)))
-    (jsobject-ref package-meta "name")))
+         (package-meta (call-with-input-file package.json json->scm)))
+    (assoc-ref package-meta "name")))

 (define (index-modules input-paths)
   (define (list-modules directory)
@@ -167,49 +115,59 @@ (define* (patch-dependencies #:key inputs
#:allow-other-keys)

   (define index (index-modules (map cdr inputs)))

-  (define resolve-dependencies
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (map (match-lambda
-                       ((key . value)
-                        (cons key (hash-ref index key value))))
-                     alist)))))
+  (define (resolve-dependencies dependencies)
+    (map
+      (match-lambda
+        ((dependency . version)
+          (cons dependency (hash-ref index dependency version))))
+      dependencies))

-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,resolve-dependencies (@))
-       `("dependencies" ,(lambda (deps)
-                           (resolve-dependencies
-                            (jsobject-union
-                             (lambda (k a b) b)
-                             (jsobject-ref pkg-meta "peerDependencies" '(@))
-                             deps)))
-         (@)))))
+      (fold
+        (lambda (proc pkg-meta) (proc pkg-meta))
+        pkg-meta
+        (list
+          (lambda (pkg-meta)
+            (alist-update pkg-meta "devDependencies" resolve-dependencies))
+          (lambda (pkg-meta)
+            (assoc-set!
+              pkg-meta
+              "dependencies"
+              (resolve-dependencies
+                ; Combined "peerDependencies" and "dependencies" dependencies
+                ; with "dependencies" taking precedent.
+                (fold
+                  (lambda (dependency dependencies)
+                    (apply assoc-set! dependencies dependency))
+                  (assoc-ref* pkg-meta "peerDependencies" '())
+                  (assoc-ref* pkg-meta "dependencies" '())))))))))
   #t)

-(define (delete-dependencies absent)
+(define (delete-dependencies dependencies-to-remove)
   "Rewrite 'package.json' to allow the build to proceed without packages
-listed in ABSENT, a list of strings naming npm packages.
+listed in 'dependencies-to-remove', a list of strings naming npm packages.

 To prevent the deleted dependencies from being reintroduced, use this function
 only after the 'patch-dependencies' phase."
-  (define delete-from-jsobject
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (filter (match-lambda
-                          ((k . _)
-                           (not (member k absent))))
-                        alist)))))
-
-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,delete-from-jsobject (@))
-       `("dependencies" ,delete-from-jsobject (@))
-       `("peerDependencies" ,delete-from-jsobject (@))))))
+      (fold
+        (lambda (dependency-key pkg-meta)
+          (alist-update
+            pkg-meta
+            dependency-key
+            (lambda (dependencies)
+              (remove
+                (lambda (dependency)
+                  (member (car dependency) dependencies-to-remove))
+                dependencies))))
+        pkg-meta
+        (list
+          "devDependencies"
+          "dependencies"
+          "peerDependencies"
+          "optionalDependencies")))))

 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
@@ -228,8 +186,8 @@ (define* (configure #:key outputs inputs #:allow-other-keys)
     #t))

 (define* (build #:key inputs #:allow-other-keys)
-  (let ((package-meta (call-with-input-file "package.json" read-json)))
-    (if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f)
+  (let ((package-meta (call-with-input-file "package.json" json->scm)))
+    (if (assoc-ref* (assoc-ref* package-meta "scripts" '()) "build" #f)
         (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
           (invoke npm "run" "build"))
         (format #t "there is no build script to run~%"))
@@ -301,22 +259,20 @@ (define* (avoid-node-gyp-rebuild #:key outputs
#:allow-other-keys)
   ;; even need to overwrite this file.  Therefore, let's use some helpers
   ;; that we'd otherwise not need.
   (define pkg-meta
-    (call-with-input-file installed-package.json read-json))
+    (call-with-input-file installed-package.json json->scm))
   (define scripts
-    (jsobject-ref pkg-meta "scripts" '(@)))
-  (define (jsobject-set js key val)
-    (jsobject-update* js (list key (const val))))
+    (assoc-ref* pkg-meta "scripts" '()))

-  (when (equal? "node-gyp rebuild" (jsobject-ref scripts "install" #f))
+  (when (equal? "node-gyp rebuild" (assoc-ref* scripts "install" #f))
     (call-with-output-file installed-package.json
       (lambda (out)
-        (write-json
-         (jsobject-set pkg-meta
-                       "scripts"
-                       (jsobject-set scripts
-                                     "install"
-                                     "echo Guix: avoiding node-gyp rebuild"))
-         out)))))
+        (scm->json
+          (assoc-set! pkg-meta
+                      "scripts"
+                      (assoc-set! scripts
+                                  "install"
+                                  "echo Guix: avoiding node-gyp rebuild"))
+          out)))))

 (define %standard-phases
   (modify-phases gnu:%standard-phases

base-commit: e16cdcf37d8223b3634ec5e658356c3b7f154859
-- 
2.46.0
[0001-Replace-guix-build-json-with-json-in-node-build-syst.patch (text/x-patch, attachment)]

Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sat, 28 Dec 2024 00:01:01 GMT) Full text and rfc822 format available.

Message #14 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Subject: Re:
Date: Fri, 27 Dec 2024 23:58:50 +0000
The rationale of this patch are the following reasons:

1. Since (json) is a dependency of guix, there's no need to roll out
own (guix build json) which does the same thing.
2. (guix build json)'s write-json escapes forward slashes in strings
for some reason ("/" become "\/")
3. (guix build json)'s read-json produces an awkward to use structure
similar to an association list but with '@' to indicate an object, and
arrays are just lists. (json)'s json->scm produces a regular guile
association list for objects and uses #(...) for lists. Overall this
difference leads to easier to read and maintain code as can be seen in
the patch. No longer need to match '@' for example, we can use the
regular association list procedures directly.




Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sat, 28 Dec 2024 19:02:01 GMT) Full text and rfc822 format available.

Message #17 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Subject: Re:
Date: Sat, 28 Dec 2024 19:00:38 +0000
[Message part 1 (text/plain, inline)]
Tested the patch and ran into an issue that was introduced when I
shortened some lines to within 80 characters, fixed this now and also
included the additional rationale in the patch descriptions.
[0001-Replace-guix-build-json-with-json-in-node-build-syst.patch (text/x-patch, attachment)]

Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sun, 29 Dec 2024 21:57:01 GMT) Full text and rfc822 format available.

Message #20 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Subject: [PATCH 0/2] Improve node-build-system helper procedures
Date: Sun, 29 Dec 2024 21:54:54 +0000
Added a new patch to add a few helper functions to clean up operations
which modify the package.json file such as removing and replacing
fields.

The first patch is the same as above, use (json) instead of (guix
build json), and the second patch expands on the first by introducing
new exported procedures.




Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sun, 29 Dec 2024 21:58:02 GMT) Full text and rfc822 format available.

Message #23 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Subject: [PATCH 1/2] Replace (guix build json) with (json) in node-build-system
Date: Sun, 29 Dec 2024 21:56:41 +0000
[Message part 1 (text/plain, inline)]
This change replaces the use of (guix build json) with (json) for the
node ecosystem.
Since guile-json is a dependency of Guix, and it's used elsewhere in
the project, it makes sense to use this instead of rolling our own
JSON implementation with (guix build json).

(guix build json) also has a few issues:
 - write-json escapes forward slashes in strings for some reason ("/"
become "\/")
 - read-json produces a structure similar to an association list but
with '@' to indicate an object, making it not possible to use
association list procedures directly.

This is one step to move away from (guix build json), there will be
other changes to remove the other uses of it.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I9fd5152a98b6a241d414e9a94ab179c9cabcfb85
---
 gnu/packages/node-xyz.scm        | 148 ++++++++++++-------------
 guix/build-system/node.scm       |   6 +-
 guix/build/node-build-system.scm | 180 ++++++++++++-------------------
 3 files changed, 139 insertions(+), 195 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index e98eda2a01..ec3f9fbfb1 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Dhruvin Gandhi <contact <at> dhruvin.dev>
 ;;; Copyright © 2022 Nicolas Graves <ngraves <at> ngraves.fr>
 ;;; Copyright © 2023 Jelle Licht <jlicht <at> fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,14 +25,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu packages node-xyz)
-  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (gnu packages sqlite)
   #:use-module (gnu packages python)
   #:use-module (gnu packages web)
+  #:use-module (guix build-system node)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix git-download)
-  #:use-module (guix build-system node))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix packages))

 ;;;
 ;;; Please: Try to add new module packages in alphabetic order.
@@ -69,19 +70,17 @@ (define-public node-acorn
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
              ;; TODO: Add utility function
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("prepare" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other other))
-                                pkg-meta-alist)))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("prepare" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist)))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -158,23 +157,17 @@ (define-public node-addon-api
            (lambda args
              (define new-test-script
                "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons
-                   '@
-                   (map (match-lambda
-                          (("scripts" '@ . scripts-alist)
-                           `("scripts" @ ,@(map (match-lambda
-                                                  (("test" . _)
-                                                   (cons "test"
-                                                         new-test-script))
-                                                  (other
-                                                   other))
-                                                scripts-alist)))
-                          (other
-                           other))
-                        pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (map
+                       (match-lambda
+                         (("test" . _) (cons "test" new-test-script))
+                         (other other))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -1223,22 +1216,19 @@ (define-public node-serialport-bindings
                                     "node-abi"))))
          (add-after 'chdir 'avoid-prebuild-install
            (lambda args
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (("gypfile" . _)
-                                   '("gypfile" . #f))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (("gypfile" . _)
+                     (cons "gypfile" #f))
+                   (other other))
+                 pkg-meta-alist))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1524,39 +1514,33 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (match (assoc-ref pkg-meta-alist "binary")
-                    (('@ . binary-alist)
-                     ;; When it builds from source, node-pre-gyp supplies
-                     ;; module_name and module_path based on the entries under
-                     ;; "binary" from "package.json", so this package's
-                     ;; "binding.gyp" doesn't define them. Thus, we also need
-                     ;; to supply them. The GYP_DEFINES environment variable
-                     ;; turns out to be the easiest way to make sure they are
-                     ;; propagated from npm to node-gyp to gyp.
-                     (setenv "GYP_DEFINES"
-                             (string-append
-                              "module_name="
-                              (assoc-ref binary-alist "module_name")
-                              " "
-                              "module_path="
-                              (assoc-ref binary-alist "module_path")))))
-                  ;; We need to remove the install script from "package.json",
-                  ;; as it would try to use node-pre-gyp and would block the
-                  ;; automatic building performed by `npm install`.
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+                 ;; When it builds from source, node-pre-gyp supplies
+                 ;; module_name and module_path based on the entries under
+                 ;; "binary" from "package.json", so this package's
+                 ;; "binding.gyp" doesn't define them. Thus, we also need
+                 ;; to supply them. The GYP_DEFINES environment variable
+                 ;; turns out to be the easiest way to make sure they are
+                 ;; propagated from npm to node-gyp to gyp.
+                 (setenv "GYP_DEFINES" (string-append
+                   "module_name="
+                   (assoc-ref binary-alist "module_name")
+                   " module_path="
+                   (assoc-ref binary-alist "module_path"))))
+               ;; We need to remove the install script from "package.json",
+               ;; as it would try to use node-pre-gyp and would block the
+               ;; automatic building performed by `npm install`.
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 57fe5f6030..425b8cd9b3 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
 ;;; Copyright © 2021 Philip McGrath <philip <at> philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,10 @@ (define-module (guix build-system node)
 (define %node-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build node-build-system)
-    (guix build json)
+    (json)
+    (json builder)
+    (json parser)
+    (json record)
     ,@%default-gnu-imported-modules))

 (define (default-node)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index fb23894bc1..df7ea7774c 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019, 2021 Timothy Sample <samplet <at> ngyro.com>
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler <at> gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,10 +24,10 @@
 (define-module (guix build node-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
-  #:use-module (guix build json)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
@@ -34,13 +35,14 @@ (define-module (guix build node-build-system)
             delete-dependencies
             node-build))

-(define (with-atomic-json-file-replacement file proc)
+(define* (with-atomic-json-file-replacement proc
+  #:optional (file "package.json"))
   "Like 'with-atomic-file-replacement', but PROC is called with a single
 argument---the result of parsing FILE's contents as json---and should a value
 to be written as json to the replacement FILE."
   (with-atomic-file-replacement file
     (lambda (in out)
-      (write-json (proc (read-json in)) out))))
+      (scm->json (proc (json->scm in)) out))))

 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -48,10 +50,6 @@ (define* (assoc-ref* alist key #:optional default)
     (#f default)
     ((_ . value) value)))

-(define* (jsobject-ref obj key #:optional default)
-  (match obj
-    (('@ . alist) (assoc-ref* alist key default))))
-
 (define* (alist-pop alist key #:optional (= equal?))
   "Return two values, the first pair in ALIST with key KEY, and the other
 elements.  Equality calls are made as (= KEY ALISTCAR)."
@@ -63,67 +61,17 @@ (define* (alist-pop alist key #:optional (= equal?))
         (values (car after) (append before (cdr after)))
         (values #f before))))

-(define* (alist-update alist key proc #:optional default (= equal?))
+(define* (alist-update alist key proc #:optional (= equal?))
   "Return an association list like ALIST, but with KEY mapped to the result of
 PROC applied to the first value found under the comparison (= KEY ALISTCAR).
-If no such value exists, use DEFAULT instead.
+If no such value exists, return the list unchanged.
 Unlike acons, this removes the previous association of KEY (assuming it is
 unique), but the result may still share storage with ALIST."
   (let ((pair rest (alist-pop alist key =)))
-    (acons key
-           (proc (if (pair? pair)
-                     (cdr pair)
-                     default))
-           rest)))
-
-(define (jsobject-update* js . updates)
-  "Return a json object like JS, but with all UPDATES applied.  Each update is
-a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of PROC
-applied to the value to which KEY is mapped in JS.  If no such mapping exists,
-PROC is instead applied to DEFAULT, or to '#f' is no DEFAULT is specified.
-The update takes place from left to right, so later UPDATERs will receive the
-values returned by earlier UPDATERs for the same KEY."
-  (match js
-    (('@ . alist)
-     (let loop ((alist alist)
-                (updates updates))
-       (match updates
-         (() (cons '@ alist))
-         (((key proc) . updates)
-          (loop (alist-update alist key proc #f equal?) updates))
-         (((key proc default) . updates)
-          (loop (alist-update alist key proc default equal?) updates)))))))
-
-(define (jsobject-union combine seed . objects)
-  "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0
-is the value found in the (possibly updated) SEED and VAL is the new value
-found in one of the OBJECTS."
-  (match seed
-    (('@ . aseed)
-     (match objects
-       (() seed)
-       ((('@ . alists) ...)
-        (cons
-         '@
-         (fold (lambda (alist aseed)
-                 (if (null? aseed) alist
-                     (fold
-                      (match-lambda*
-                        (((k . v) aseed)
-                         (let ((pair tail (alist-pop alist k)))
-                           (match pair
-                             (#f (acons k v aseed))
-                             ((_ . v0) (acons k (combine k v0 v) aseed))))))
-                      aseed
-                      alist)))
-               aseed
-               alists)))))))
+    (if (pair? pair)
+      (acons key (proc (cdr pair)) rest)
+      alist)))

-;; Possibly useful helper functions:
-;; (define (newest key val0 val) val)
-;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val)))
-
-
 ;;;
 ;;; Phases.
 ;;;
@@ -142,8 +90,8 @@ (define (set-home . _)

 (define (module-name module)
   (let* ((package.json (string-append module "/package.json"))
-         (package-meta (call-with-input-file package.json read-json)))
-    (jsobject-ref package-meta "name")))
+         (package-meta (call-with-input-file package.json json->scm)))
+    (assoc-ref package-meta "name")))

 (define (index-modules input-paths)
   (define (list-modules directory)
@@ -167,49 +115,59 @@ (define* (patch-dependencies #:key inputs
#:allow-other-keys)

   (define index (index-modules (map cdr inputs)))

-  (define resolve-dependencies
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (map (match-lambda
-                       ((key . value)
-                        (cons key (hash-ref index key value))))
-                     alist)))))
+  (define (resolve-dependencies dependencies)
+    (map
+      (match-lambda
+        ((dependency . version)
+          (cons dependency (hash-ref index dependency version))))
+      dependencies))

-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,resolve-dependencies (@))
-       `("dependencies" ,(lambda (deps)
-                           (resolve-dependencies
-                            (jsobject-union
-                             (lambda (k a b) b)
-                             (jsobject-ref pkg-meta "peerDependencies" '(@))
-                             deps)))
-         (@)))))
+      (fold
+        (lambda (proc pkg-meta) (proc pkg-meta))
+        pkg-meta
+        (list
+          (lambda (pkg-meta)
+            (alist-update pkg-meta "devDependencies" resolve-dependencies))
+          (lambda (pkg-meta)
+            (assoc-set!
+              pkg-meta
+              "dependencies"
+              (resolve-dependencies
+                ; Combined "peerDependencies" and "dependencies" dependencies
+                ; with "dependencies" taking precedent.
+                (fold
+                  (lambda (dependency dependencies)
+                    (assoc-set! dependencies (car dependency) (cdr
dependency)))
+                  (assoc-ref* pkg-meta "peerDependencies" '())
+                  (assoc-ref* pkg-meta "dependencies" '())))))))))
   #t)

-(define (delete-dependencies absent)
+(define (delete-dependencies dependencies-to-remove)
   "Rewrite 'package.json' to allow the build to proceed without packages
-listed in ABSENT, a list of strings naming npm packages.
+listed in 'dependencies-to-remove', a list of strings naming npm packages.

 To prevent the deleted dependencies from being reintroduced, use this function
 only after the 'patch-dependencies' phase."
-  (define delete-from-jsobject
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (filter (match-lambda
-                          ((k . _)
-                           (not (member k absent))))
-                        alist)))))
-
-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,delete-from-jsobject (@))
-       `("dependencies" ,delete-from-jsobject (@))
-       `("peerDependencies" ,delete-from-jsobject (@))))))
+      (fold
+        (lambda (dependency-key pkg-meta)
+          (alist-update
+            pkg-meta
+            dependency-key
+            (lambda (dependencies)
+              (remove
+                (lambda (dependency)
+                  (member (car dependency) dependencies-to-remove))
+                dependencies))))
+        pkg-meta
+        (list
+          "devDependencies"
+          "dependencies"
+          "peerDependencies"
+          "optionalDependencies")))))

 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
@@ -228,8 +186,8 @@ (define* (configure #:key outputs inputs #:allow-other-keys)
     #t))

 (define* (build #:key inputs #:allow-other-keys)
-  (let ((package-meta (call-with-input-file "package.json" read-json)))
-    (if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f)
+  (let ((package-meta (call-with-input-file "package.json" json->scm)))
+    (if (assoc-ref* (assoc-ref* package-meta "scripts" '()) "build" #f)
         (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
           (invoke npm "run" "build"))
         (format #t "there is no build script to run~%"))
@@ -301,22 +259,20 @@ (define* (avoid-node-gyp-rebuild #:key outputs
#:allow-other-keys)
   ;; even need to overwrite this file.  Therefore, let's use some helpers
   ;; that we'd otherwise not need.
   (define pkg-meta
-    (call-with-input-file installed-package.json read-json))
+    (call-with-input-file installed-package.json json->scm))
   (define scripts
-    (jsobject-ref pkg-meta "scripts" '(@)))
-  (define (jsobject-set js key val)
-    (jsobject-update* js (list key (const val))))
+    (assoc-ref* pkg-meta "scripts" '()))

-  (when (equal? "node-gyp rebuild" (jsobject-ref scripts "install" #f))
+  (when (equal? "node-gyp rebuild" (assoc-ref* scripts "install" #f))
     (call-with-output-file installed-package.json
       (lambda (out)
-        (write-json
-         (jsobject-set pkg-meta
-                       "scripts"
-                       (jsobject-set scripts
-                                     "install"
-                                     "echo Guix: avoiding node-gyp rebuild"))
-         out)))))
+        (scm->json
+          (assoc-set! pkg-meta
+                      "scripts"
+                      (assoc-set! scripts
+                                  "install"
+                                  "echo Guix: avoiding node-gyp rebuild"))
+          out)))))

 (define %standard-phases
   (modify-phases gnu:%standard-phases

base-commit: e16cdcf37d8223b3634ec5e658356c3b7f154859
-- 
2.46.0
[0001-Replace-guix-build-json-with-json-in-node-build-system.patch (text/x-patch, attachment)]

Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sun, 29 Dec 2024 22:00:02 GMT) Full text and rfc822 format available.

Message #26 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
To: 74900 <at> debbugs.gnu.org
Subject: [PATCH 2/2] Introduce (modify-json), (delete-fields), and
 (replace-fields) to node-build-system
Date: Sun, 29 Dec 2024 21:58:35 +0000
[Message part 1 (text/plain, inline)]
This change introduces helper procedures (modify-json) which takes in lambdas
 which modify the target json #:file which defaults to package.json
This change also includes (delete-fields) and (replace-fields) to help deleting
 and replacing the value of fields in a package.json file.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I957f7ca814078d2136d5261985174820235f1369
---
 gnu/packages/node-xyz.scm        | 324 ++++++++++++++-----------------
 gnu/packages/node.scm            |  86 ++++----
 guix/build/node-build-system.scm | 198 +++++++++++++++----
 3 files changed, 355 insertions(+), 253 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index ec3f9fbfb1..cdc69de0c1 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -69,18 +69,7 @@ (define-public node-acorn
              ;; We need to remove the prepare script from "package.json", as
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
-             ;; TODO: Add utility function
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (filter
-                       (match-lambda
-                         (("prepare" . _) #f)
-                         (_ #t))
-                       scripts-alist)))
-                   (other other))
-                 pkg-meta-alist)))))
+             (modify-json (delete-fields '(("scripts" "prepare"))))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -136,38 +125,26 @@ (define-public node-addon-api
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              `("benchmark"
-                "bindings"
-                "clang-format"
-                "eslint"
-                "eslint-config-semistandard"
-                "eslint-config-standard"
-                "eslint-plugin-import"
-                "eslint-plugin-node"
-                "eslint-plugin-promise"
-                "fs-extra"
-                "neostandard"
-                "path"
-                "pre-commit"
-                "semver"))))
-         (add-after 'unpack 'skip-js-tests
-           ;; We can't run the js-based tests,
-           ;; but we can still do the C++ parts
-           (lambda args
-             (define new-test-script
-               "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (map
-                       (match-lambda
-                         (("test" . _) (cons "test" new-test-script))
-                         (other other))
-                       scripts-alist)))
-                   (other other))
-                 pkg-meta-alist))))))))
+             (modify-json
+               (delete-dependencies `(
+                 "benchmark"
+                 "bindings"
+                 "clang-format"
+                 "eslint"
+                 "eslint-config-semistandard"
+                 "eslint-config-standard"
+                 "eslint-plugin-import"
+                 "eslint-plugin-node"
+                 "eslint-plugin-promise"
+                 "fs-extra"
+                 "neostandard"
+                 "path"
+                 "pre-commit"
+                 "semver"))
+               ;; We can't run the js-based tests,
+               ;; but we can still do the C++ parts
+               (replace-fields (list (cons
+                 "scripts.test" "echo stopping after pretest on Guix")))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -232,7 +209,7 @@ (define-public node-buffer-crc32
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("tap")))))))
+                      (modify-json (delete-dependencies '("tap"))))))))
     (home-page "https://github.com/brianloveswords/buffer-crc32")
     (synopsis "CRC32 implementation in Javascript")
     (description
@@ -288,14 +265,15 @@ (define-public node-crx3
                          "minimist"))))
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("c8"
-                                             "docdash"
-                                             "eslint"
-                                             "eslint-plugin-jsdoc"
-                                             "jsdoc"
-                                             "tap-diff"
-                                             "tape"
-                                             "tape-catch")))))))
+                      (modify-json (delete-dependencies
+                        '("c8"
+                          "docdash"
+                          "eslint"
+                          "eslint-plugin-jsdoc"
+                          "jsdoc"
+                          "tap-diff"
+                          "tape"
+                          "tape-catch"))))))))
     (inputs (list node-minimist node-pbf node-yazl))
     (home-page "https://github.com/ahwayakchih/crx3")
     (synopsis "Create CRXv3 browser extensions with Javascript")
@@ -325,18 +303,19 @@ (define-public node-debug
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("brfs"
-                                    "browserify"
-                                    "coveralls"
-                                    "istanbul"
-                                    "karma"
-                                    "karma-browserify"
-                                    "karma-chrome-launcher"
-                                    "karma-mocha"
-                                    "mocha"
-                                    "mocha-lcov-reporter"
-                                    "xo"
-                                    "supports-color")))))
+             (modify-json (delete-dependencies
+               `("brfs"
+                 "browserify"
+                 "coveralls"
+                 "istanbul"
+                 "karma"
+                 "karma-browserify"
+                 "karma-chrome-launcher"
+                 "karma-mocha"
+                 "mocha"
+                 "mocha-lcov-reporter"
+                 "xo"
+                 "supports-color"))))))
        #:tests? #f))
     (home-page "https://github.com/debug-js/debug")
     (synopsis "Debugging utility for Node.js")
@@ -421,21 +400,22 @@ (define-public node-file-uri-to-path
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@types/mocha"
-                                    "@types/node"
-                                    "@typescript-eslint/eslint-plugin"
-                                    "@typescript-eslint/parser"
-                                    "cpy-cli"
-                                    "eslint"
-                                    "eslint-config-airbnb"
-                                    "eslint-config-prettier"
-                                    "eslint-import-resolver-typescript"
-                                    "eslint-plugin-import"
-                                    "eslint-plugin-jsx-a11y"
-                                    "eslint-plugin-react"
-                                    "mocha"
-                                    "rimraf"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+               `("@types/mocha"
+                 "@types/node"
+                 "@typescript-eslint/eslint-plugin"
+                 "@typescript-eslint/parser"
+                 "cpy-cli"
+                 "eslint"
+                 "eslint-config-airbnb"
+                 "eslint-config-prettier"
+                 "eslint-import-resolver-typescript"
+                 "eslint-plugin-import"
+                 "eslint-plugin-jsx-a11y"
+                 "eslint-plugin-react"
+                 "mocha"
+                 "rimraf"
+                 "typescript")))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (copy-recursively "src" "dist")
@@ -497,7 +477,8 @@ (define-public node-ieee754
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("airtap" "standard" "tape")))))))
+                      (modify-json (delete-dependencies
+                        '("airtap" "standard" "tape"))))))))
     (home-page "https://github.com/feross/ieee754")
     (synopsis "Read/write IEEE754 floating point numbers in Javascript")
     (description "This package can read and write IEEE754 floating point
@@ -524,7 +505,7 @@ (define-public node-inherits
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))
+             (modify-json (delete-dependencies '("tap"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (home-page "https://github.com/isaacs/inherits")
@@ -553,8 +534,8 @@ (define-public node-irc
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              `("ansi-color" "faucet" "jscs" "tape")))))
+             (modify-json (delete-dependencies
+              `("ansi-color" "faucet" "jscs" "tape"))))))
        #:tests? #f))
     (inputs
      (list node-irc-colors))
@@ -583,7 +564,7 @@ (define-public node-irc-colors
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("istanbul" "vows")))))
+             (modify-json (delete-dependencies `("istanbul" "vows"))))))
        #:tests? #f))
     (home-page "https://github.com/fent/irc-colors.js")
     (synopsis "Node.js module providing color and formatting for IRC")
@@ -657,7 +638,8 @@ (define-public node-minimist
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("covert" "tap" "tape")))))))
+                      (modify-json (delete-dependencies
+                        '("covert" "tap" "tape"))))))))
     (home-page "https://github.com/substack/minimist")
     (synopsis "Parse CLI arguments in Javascript")
     (description "This package can scan for CLI flags and arguments in
@@ -683,12 +665,13 @@ (define-public node-ms
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("eslint"
-                                    "expect.js"
-                                    "husky"
-                                    "lint-staged"
-                                    "mocha"
-                                    "prettier")))))
+             (modify-json (delete-dependencies
+               `("eslint"
+                 "expect.js"
+                 "husky"
+                 "lint-staged"
+                 "mocha"
+                 "prettier"))))))
        #:tests? #f))
     (home-page "https://github.com/vercel/ms")
     (synopsis "Convert time to milliseconds")
@@ -716,14 +699,14 @@ (define-public node-nan
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
+             (modify-json (delete-dependencies
               '("bindings"
                 "commander"
                 "glob"
                 "request"
                 "node-gyp" ;; would be needed for tests
                 "tap"
-                "xtend")))))
+                "xtend"))))))
        ;; tests need tap and other dependencies
        #:tests? #f))
     (inputs
@@ -755,7 +738,8 @@ (define-public node-normalize-path
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("gulp-format-md" "mocha")))))))
+                      (modify-json (delete-dependencies
+                        '("gulp-format-md" "mocha"))))))))
     (native-inputs (list node-minimist))
     (home-page "https://github.com/jonschlinkert/normalize-path")
     (synopsis "Normalize slashes in a file path")
@@ -784,7 +768,7 @@ (define-public node-once
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))
+             (modify-json (delete-dependencies '("tap"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (inputs
@@ -841,7 +825,8 @@ (define-public node-path-key
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("@types/node" "ava"
"tsd" "xo")))))))
+                      (modify-json (delete-dependencies
+                        '("@types/node" "ava" "tsd" "xo"))))))))
     (home-page "https://github.com/sindresorhus/path-key")
     (synopsis "Cross-platform utility to compute the PATH environment
variable key")
     (description "@code{path-key} provides an implementation to compute the
@@ -867,7 +852,7 @@ (define-public node-pbf
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies
+                      (modify-json (delete-dependencies
                        '("benchmark"
                          "browserify"
                          "eslint"
@@ -877,7 +862,7 @@ (define-public node-pbf
                          "protocol-buffers"
                          "tap"
                          "tile-stats-runner"
-                         "uglify-js")))))))
+                         "uglify-js"))))))))
     (inputs (list node-ieee754 node-resolve-protobuf-schema))
     (home-page "https://github.com/mapbox/pbf")
     (synopsis "Decode and encode protocol buffers in Javascript")
@@ -908,7 +893,8 @@ (define-public node-protocol-buffers-schema
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("standard" "tape")))))))
+                      (modify-json (delete-dependencies
+                        '("standard" "tape"))))))))
     (home-page "https://github.com/mafintosh/protocol-buffers-schema")
     (synopsis "Protocol buffers schema parser written in Javascript")
     (description "This package provides a protocol buffers schema parser
@@ -935,26 +921,27 @@ (define-public node-readable-stream
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@babel/cli"
-                                    "@babel/core"
-                                    "@babel/polyfill"
-                                    "@babel/preset-env"
-                                    "airtap"
-                                    "assert"
-                                    "bl"
-                                    "deep-strict-equal"
-                                    "events.once"
-                                    "glob"
-                                    "gunzip-maybe"
-                                    "hyperquest"
-                                    "lolex"
-                                    "nyc"
-                                    "pump"
-                                    "rimraf"
-                                    "tap"
-                                    "tape"
-                                    "tar-fs"
-                                    "util-promisify")))))
+             (modify-json (delete-dependencies
+               `("@babel/cli"
+                 "@babel/core"
+                 "@babel/polyfill"
+                 "@babel/preset-env"
+                 "airtap"
+                 "assert"
+                 "bl"
+                 "deep-strict-equal"
+                 "events.once"
+                 "glob"
+                 "gunzip-maybe"
+                 "hyperquest"
+                 "lolex"
+                 "nyc"
+                 "pump"
+                 "rimraf"
+                 "tap"
+                 "tape"
+                 "tar-fs"
+                 "util-promisify"))))))
        #:tests? #f))
     (inputs (list node-util-deprecate node-string-decoder node-inherits))
     (home-page "https://github.com/nodejs/readable-stream")
@@ -983,7 +970,8 @@ (define-public node-resolve-protobuf-schema
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("standard" "tape")))))))
+                      (modify-json (delete-dependencies
+                        '("standard" "tape"))))))))
     (inputs (list node-protocol-buffers-schema))
     (home-page "https://github.com/mafintosh/resolve-protobuf-schema")
     (synopsis "Resolve protobuf imports")
@@ -1012,7 +1000,7 @@ (define-public node-safe-buffer
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tape" "standard")))))
+             (modify-json (delete-dependencies '("tape" "standard"))))))
        #:tests? #f))
     (home-page "https://github.com/feross/safe-buffer")
     (synopsis "Buffer creation with explicit semantics")
@@ -1040,20 +1028,21 @@ (define-public node-safe-stable-stringify
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("benchmark" "clone"
-                                             "fast-json-stable-stringify"
-                                             "fast-safe-stringify"
-                                             "fast-stable-stringify"
-                                             "faster-stable-stringify"
-                                             "fastest-stable-stringify"
-                                             "json-stable-stringify"
-                                             "json-stringify-deterministic"
-                                             "json-stringify-safe"
-                                             "standard"
-                                             "tap"
-                                             "typescript"
-                                             "@types/node"
-
"@types/json-stable-stringify")))))))
+                      (modify-json (delete-dependencies
+                        '("benchmark" "clone"
+                          "fast-json-stable-stringify"
+                          "fast-safe-stringify"
+                          "fast-stable-stringify"
+                          "faster-stable-stringify"
+                          "fastest-stable-stringify"
+                          "json-stable-stringify"
+                          "json-stringify-deterministic"
+                          "json-stringify-safe"
+                          "standard"
+                          "tap"
+                          "typescript"
+                          "@types/node"
+                          "@types/json-stable-stringify"))))))))
     (home-page "https://github.com/BridgeAR/safe-stable-stringify")
     (synopsis "Serialization of javascript objects")
     (description
@@ -1111,7 +1100,7 @@ (define-public node-semver
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))
+             (modify-json (delete-dependencies '("tap"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (home-page "https://github.com/npm/node-semver")
@@ -1151,7 +1140,8 @@ (define-public node-serialport
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@serialport/binding-mock"))))
+             (modify-json (delete-dependencies
+               `("@serialport/binding-mock")))))
          (add-after 'unpack 'chdir
            (lambda args
              (chdir "packages/serialport"))))
@@ -1210,25 +1200,10 @@ (define-public node-serialport-bindings
              (chdir "packages/bindings")))
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("prebuild-install"
-                                    ;; devDependencies
-                                    "@serialport/binding-mock"
-                                    "node-abi"))))
-         (add-after 'chdir 'avoid-prebuild-install
-           (lambda args
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (filter
-                       (match-lambda
-                         (("install" . _) #f)
-                         (_ #t))
-                       scripts-alist)))
-                   (("gypfile" . _)
-                     (cons "gypfile" #f))
-                   (other other))
-                 pkg-meta-alist))))))
+             (modify-json
+               (delete-dependencies `(
+                 ;; devDependencies
+                 "node-abi"))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1409,8 +1384,9 @@ (define-public node-serialport-stream
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `(;; devDependencies
-                                    "@serialport/binding-mock"))))
+             (modify-json
+               (delete-dependencies ;; devDependencies
+                 `("@serialport/binding-mock")))))
          (add-after 'unpack 'chdir
            (lambda args
              (chdir "packages/stream"))))
@@ -1461,7 +1437,7 @@ (define-public node-sqlite3
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
+             (modify-json (delete-dependencies
               `(;; Normally, this is "built" using @mapbox/node-pre-gyp,
                 ;; which publishes or downloads pre-built binaries or
                 ;; falls back to building from source.  Here, we patch out
@@ -1480,7 +1456,7 @@ (define-public node-sqlite3
                 "node-gyp"
                 ;; These we'd like, we just don't have them yet:
                 "eslint"
-                "mocha"))))
+                "mocha")))))
          (add-before 'configure 'npm-config-sqlite
            ;; We need this step even if we do replace @mapbox/node-pre-gyp
            ;; because the package expects to build its bundled sqlite
@@ -1514,8 +1490,9 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+             (modify-json
+               (lambda (pkg-meta-alist)
+                 (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
                  ;; When it builds from source, node-pre-gyp supplies
                  ;; module_name and module_path based on the entries under
                  ;; "binary" from "package.json", so this package's
@@ -1528,19 +1505,11 @@ (define-public node-sqlite3
                    (assoc-ref binary-alist "module_name")
                    " module_path="
                    (assoc-ref binary-alist "module_path"))))
+                 pkg-meta-alist)
                ;; We need to remove the install script from "package.json",
                ;; as it would try to use node-pre-gyp and would block the
                ;; automatic building performed by `npm install`.
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (filter
-                       (match-lambda
-                         (("install" . _) #f)
-                         (_ #t))
-                       scripts-alist)))
-                   (other other))
-                 pkg-meta-alist))))))))
+               (delete-fields `(("scripts" "install")))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
@@ -1623,8 +1592,8 @@ (define-public node-string-decoder
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              '("tap" "core-util-is" "babel-polyfill")))))
+             (modify-json (delete-dependencies
+              '("tap" "core-util-is" "babel-polyfill"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (inputs (list node-safe-buffer node-inherits))
@@ -1678,7 +1647,7 @@ (define-public node-wrappy
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))))
+             (modify-json (delete-dependencies '("tap"))))))))
     (home-page "https://github.com/npm/wrappy")
     (synopsis "Callback wrapping utility")
     (description "@code{wrappy} is a utility for Node.js to wrap callbacks.")
@@ -1703,7 +1672,8 @@ (define-public node-yazl
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("airtap" "bl" "istanbul"
"yauzl")))))))
+                      (modify-json (delete-dependencies
+                        '("airtap" "bl" "istanbul" "yauzl"))))))))
     (inputs (list node-buffer-crc32))
     (home-page "https://github.com/thejoshwolfe/yazl")
     (synopsis "Yet another zip library for node")
diff --git a/gnu/packages/node.scm b/gnu/packages/node.scm
index 20acffb3df..a13ec5d077 100644
--- a/gnu/packages/node.scm
+++ b/gnu/packages/node.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Hilton Chain <hako <at> ultrarare.space>
 ;;; Copyright © 2024 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -366,7 +367,7 @@ (define-public node-semver-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))))
+             (modify-json (delete-dependencies '("tap"))))))))
     (home-page "https://github.com/npm/node-semver")
     (properties '((hidden? . #t)))
     (synopsis "Parses semantic versions strings")
@@ -397,11 +398,12 @@ (define-public node-ms-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("eslint"
-                                    "expect.js"
-                                    "husky"
-                                    "lint-staged"
-                                    "mocha")))))))
+             (modify-json (delete-dependencies
+               '("eslint"
+                 "expect.js"
+                 "husky"
+                 "lint-staged"
+                 "mocha"))))))))
     (home-page "https://github.com/zeit/ms#readme")
     (properties '((hidden? . #t)))
     (synopsis "Tiny millisecond conversion utility")
@@ -431,7 +433,7 @@ (define-public node-binary-search-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("chai" "mocha")))))))
+             (modify-json (delete-dependencies `("chai" "mocha"))))))))
     (home-page "https://github.com/darkskyapp/binary-search#readme")
     (properties '((hidden? . #t)))
     (synopsis "Tiny binary search function with comparators")
@@ -460,17 +462,18 @@ (define-public node-debug-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("brfs"
-                                    "browserify"
-                                    "coveralls"
-                                    "istanbul"
-                                    "karma"
-                                    "karma-browserify"
-                                    "karma-chrome-launcher"
-                                    "karma-mocha"
-                                    "mocha"
-                                    "mocha-lcov-reporter"
-                                    "xo")))))))
+             (modify-json (delete-dependencies
+               `("brfs"
+                 "browserify"
+                 "coveralls"
+                 "istanbul"
+                 "karma"
+                 "karma-browserify"
+                 "karma-chrome-launcher"
+                 "karma-mocha"
+                 "mocha"
+                 "mocha-lcov-reporter"
+                 "xo"))))))))
     (inputs (list node-ms-bootstrap))
     (home-page "https://github.com/visionmedia/debug#readme")
     (properties '((hidden? . #t)))
@@ -526,12 +529,13 @@ (define-public node-llparse-builder-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda _
-             (delete-dependencies `("@types/mocha"
-                                    "@types/node"
-                                    "mocha"
-                                    "ts-node"
-                                    "tslint"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+               `("@types/mocha"
+                 "@types/node"
+                 "mocha"
+                 "ts-node"
+                 "tslint"
+                 "typescript")))))
          (replace 'build
            (lambda* (#:key inputs #:allow-other-keys)
              (let ((esbuild (search-input-file inputs "/bin/esbuild")))
@@ -587,13 +591,14 @@ (define-public node-llparse-frontend-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@types/debug"
-                                    "@types/mocha"
-                                    "@types/node"
-                                    "mocha"
-                                    "ts-node"
-                                    "tslint"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+               `("@types/debug"
+                 "@types/mocha"
+                 "@types/node"
+                 "mocha"
+                 "ts-node"
+                 "tslint"
+                 "typescript")))))
          (replace 'build
            (lambda* (#:key inputs #:allow-other-keys)
              (let ((esbuild (search-input-file inputs "/bin/esbuild")))
@@ -648,15 +653,16 @@ (define-public node-llparse-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@types/debug"
-                                    "@types/mocha"
-                                    "@types/node"
-                                    "esm"
-                                    "llparse-test-fixture"
-                                    "mocha"
-                                    "ts-node"
-                                    "tslint"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+               `("@types/debug"
+                 "@types/mocha"
+                 "@types/node"
+                 "esm"
+                 "llparse-test-fixture"
+                 "mocha"
+                 "ts-node"
+                 "tslint"
+                 "typescript")))))
          (replace 'build
            (lambda* (#:key inputs #:allow-other-keys)
              (let ((esbuild (search-input-file inputs "/bin/esbuild")))
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index df7ea7774c..ea23d92a05 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -31,18 +31,14 @@ (define-module (guix build node-build-system)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
-            with-atomic-json-file-replacement
             delete-dependencies
-            node-build))
-
-(define* (with-atomic-json-file-replacement proc
-  #:optional (file "package.json"))
-  "Like 'with-atomic-file-replacement', but PROC is called with a single
-argument---the result of parsing FILE's contents as json---and should a value
-to be written as json to the replacement FILE."
-  (with-atomic-file-replacement file
-    (lambda (in out)
-      (scm->json (proc (json->scm in)) out))))
+            delete-dev-dependencies
+            delete-fields
+            modify-json
+            modify-json-fields
+            node-build
+            replace-fields
+            with-atomic-json-file-replacement))

 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -72,6 +68,161 @@ (define* (alist-update alist key proc #:optional (= equal?))
       (acons key (proc (cdr pair)) rest)
       alist)))

+;;;
+;;; package.json modification procedures
+;;;
+
+(define* (with-atomic-json-file-replacement proc
+  #:optional (file "package.json"))
+  "Like 'with-atomic-file-replacement', but PROC is called with a single
+argument---the result of parsing FILE's contents as json---and should a value
+to be written as json to the replacement FILE."
+  (with-atomic-file-replacement file
+    (lambda (in out)
+      (scm->json (proc (json->scm in)) out))))
+
+(define* (modify-json #:key (file "package.json") #:rest all-arguments)
+  "Provide package.json modifying callbacks such as (delete-dependencies ...)"
+  (let
+    (
+      (modifications
+        (let loop ((arguments all-arguments))
+          (cond
+            ((null? arguments) '())
+            ((keyword? (car arguments)) (loop (cddr arguments)))
+            (else (cons (car arguments) (loop (cdr arguments))))))))
+    (with-atomic-json-file-replacement
+      (lambda (package)
+        (fold
+          (lambda (modification package)
+            (modification package))
+          package
+          modifications))
+      file)))
+
+(define (delete-dependencies dependencies-to-remove)
+  "Rewrite 'package.json' to allow the build to proceed without packages
+listed in 'dependencies-to-remove', a list of strings naming npm packages.
+
+To prevent the deleted dependencies from being reintroduced, use this function
+only after the 'patch-dependencies' phase."
+  (lambda (pkg-meta)
+    (fold
+      (lambda (dependency-key pkg-meta)
+        (alist-update
+          pkg-meta
+          dependency-key
+          (lambda (dependencies)
+            (remove
+              (lambda (dependency)
+                (member (car dependency) dependencies-to-remove))
+              dependencies))))
+      pkg-meta
+      (list
+        "devDependencies"
+        "dependencies"
+        "peerDependencies"
+        "optionalDependencies"))))
+
+(define* (modify-json-fields
+    fields
+    field-modifier
+    #:key
+      (field-path-mapper (lambda (field) field))
+      (insert? #f)
+      (strict? #t))
+  "Provides a lambda to supply to modify-json which modifies the specified
+ json file.
+- `fields` is a list procedure-specific data structures which should include
+ the definition of a `field-path` in one of two syntaxes: dot-syntax string
+ such as `\"devDependencies.esbuild\"`, or a list of strings such as
+ `(list \"devDependencies\" \"esbuild\")`.
+- `field-modifier` is a lambda which is invoked at the position of the field.
+ It is supplied with the current field definition, the association list (alist)
+ at the field location in the json file, and the field name, also called `key`.
+- `field-path-mapper` is a lambda which instructs where the field-path is
+ located within the field structure.
+- `insert?` allows the creation of the field and any missing intermediate
+ fields.
+- `strict?` causes an error to be thrown if the exact field-path is not found
+ in the data"
+  (lambda (package)
+    (fold
+      (lambda (field package)
+        (let*
+          (
+            (field-path (field-path-mapper field))
+            (
+              field-path
+              (cond
+                ((string? field-path)
+                  (string-split field-path #\.))
+                ((and (list? field-path) (every string? field-path))
+                  field-path)
+                (else
+                  (error
+                    (string-append
+                      "Invalid field value provided, expecting a string or a "
+                      "list of string but instead got: "
+                      (with-output-to-string (lambda _ (display
field-path))))))
+              )))
+          (let loop
+            (
+              (data package)
+              (field-path field-path))
+            (let*
+              (
+                (key (car field-path))
+                (data
+                  (if (and (not (assoc key data)) insert?)
+                    (acons key '() data)
+                    data)))
+              (if (not (assoc key data))
+                (if strict?
+                  (error (string-append
+                    "Key '" key "' was not found in data: "
+                    (with-output-to-string (lambda _ (display data)))))
+                  data)
+                (if (= (length field-path) 1)
+                  (field-modifier field data key)
+                  (assoc-set!
+                    data
+                    key
+                    (loop (assoc-ref data key) (cdr field-path)))))))))
+      package
+      fields)))
+
+(define* (delete-fields fields #:key (strict? #t))
+  "Provides a lambda to supply to modify-json which deletes the specified
+ `fields` which is a list of field-paths as mentioned in `modify-json-fields`.
+ Examples:
+  (delete-fields '(
+    (\"path\" \"to\" \"field\")
+    \"path.to.other.field\"))"
+  (modify-json-fields
+    fields
+    (lambda (_ data key)
+      (assoc-remove! data key))
+    #:strict? strict?))
+
+(define* (replace-fields fields #:key (strict? #t))
+  "Provides a lambda to supply to modify-json which replaces the value of the
+ supplied field. `fields` is a list of pairs, where the first element is the
+ field-path and the second element is the value to replace the target with.
+ Examples:
+  (replace-fields '(
+    ((\"path\" \"to\" \"field\") \"new field value\")
+    (\"path.to.other.field\" \"new field value\")))"
+  (modify-json-fields
+    fields
+    (lambda (field data key)
+      (assoc-set! data key (cdr field)))
+    #:field-path-mapper (lambda (field) (car field))
+    #:strict? strict?))
+
+(define (delete-dev-dependencies)
+  (delete-fields (list "devDependencies") #:strict #f))
+
 ;;;
 ;;; Phases.
 ;;;
@@ -144,31 +295,6 @@ (define* (patch-dependencies #:key inputs
#:allow-other-keys)
                   (assoc-ref* pkg-meta "dependencies" '())))))))))
   #t)

-(define (delete-dependencies dependencies-to-remove)
-  "Rewrite 'package.json' to allow the build to proceed without packages
-listed in 'dependencies-to-remove', a list of strings naming npm packages.
-
-To prevent the deleted dependencies from being reintroduced, use this function
-only after the 'patch-dependencies' phase."
-  (with-atomic-json-file-replacement
-    (lambda (pkg-meta)
-      (fold
-        (lambda (dependency-key pkg-meta)
-          (alist-update
-            pkg-meta
-            dependency-key
-            (lambda (dependencies)
-              (remove
-                (lambda (dependency)
-                  (member (car dependency) dependencies-to-remove))
-                dependencies))))
-        pkg-meta
-        (list
-          "devDependencies"
-          "dependencies"
-          "peerDependencies"
-          "optionalDependencies")))))
-
 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
 exist."
-- 
2.46.0
[0002-Introduce-modify-json-delete-fields-and-replace-fields.patch (text/x-patch, attachment)]

Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Fri, 17 Jan 2025 20:37:01 GMT) Full text and rfc822 format available.

Message #29 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Cc: Jelle Licht <jlicht <at> fsfe.org>, 74900 <at> debbugs.gnu.org
Subject: Re: [bug#74900] [PATCH 1/2] Replace (guix build json) with (json)
 in node-build-system
Date: Fri, 17 Jan 2025 21:36:19 +0100
Hi Daniel,

Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com> skribis:

> This change replaces the use of (guix build json) with (json) for the
> node ecosystem.
> Since guile-json is a dependency of Guix, and it's used elsewhere in
> the project, it makes sense to use this instead of rolling our own
> JSON implementation with (guix build json).
>
> (guix build json) also has a few issues:
>  - write-json escapes forward slashes in strings for some reason ("/"
> become "\/")
>  - read-json produces a structure similar to an association list but
> with '@' to indicate an object, making it not possible to use
> association list procedures directly.
>
> This is one step to move away from (guix build json), there will be
> other changes to remove the other uses of it.

Thanks for working on this!  This is tedious but important work.

Cc’ing Jelle, who knows Node packaging well.  Could you take a look,
Jelle?

One note:

>  (define %node-build-system-modules
>    ;; Build-side modules imported by default.
>    `((guix build node-build-system)
> -    (guix build json)
> +    (json)
> +    (json builder)
> +    (json parser)
> +    (json record)
>      ,@%default-gnu-imported-modules))

This ends up being used like so:

  (with-imported-modules %node-build-system-modules
    #~(…))

The effect is to copy (json …) from the user’s load path into the build
environment.  But this is not what we want, because one user might have
Guile-JSON 4.1 while another one has 4.7, and so they’d get different
derivations.

Instead, we should do:

  (with-extensions (list guile-json)
    (with-imported-modules %node-build-system-modules
      #~(…)))

With extra care to resolve ‘guile-json’ lazily via ‘module-ref’.

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Fri, 24 Jan 2025 11:33:02 GMT) Full text and rfc822 format available.

Message #32 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Jelle Licht <jlicht <at> fsfe.org>
To: Ludovic Courtès <ludo <at> gnu.org>, Daniel Khodabakhsh
 <d.khodabakhsh <at> gmail.com>
Cc: 74900 <at> debbugs.gnu.org
Subject: Re: [bug#74900] [PATCH 1/2] Replace (guix build json) with (json)
 in node-build-system
Date: Fri, 24 Jan 2025 12:32:13 +0100
Hi folks,

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hi Daniel,
>
> Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com> skribis:
>
>> This change replaces the use of (guix build json) with (json) for the
>> node ecosystem.
>> Since guile-json is a dependency of Guix, and it's used elsewhere in
>> the project, it makes sense to use this instead of rolling our own
>> JSON implementation with (guix build json).


Thanks for getting the ball rolling! I love this! (and tried doing
exactly this many moons ago, but failed because ISTR guile-json not
being a required dependency of guix back then).

>>
>> (guix build json) also has a few issues:
>>  - write-json escapes forward slashes in strings for some reason ("/"
>> become "\/")
>>  - read-json produces a structure similar to an association list but
>> with '@' to indicate an object, making it not possible to use
>> association list procedures directly.
>>
>> This is one step to move away from (guix build json), there will be
>> other changes to remove the other uses of it.

Let's focus on the node-build-system as it's relatively uncommon for now
indeed.  We could involve the e.g. the python-team (and their branch)
for getting the pyproject-build-system moved over as well after moving
the node-build-system over.

> Thanks for working on this!  This is tedious but important work.
>
> Cc’ing Jelle, who knows Node packaging well.  Could you take a look,
> Jelle?

I've put this series on top of my list after the node-lts version bump
is merged.  Daniel, do you still see yourself working on this to get it
upstreamed in the near future? If not, that is also perfectly fine of
course :)

Thanks,
 Jelle




Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Sat, 01 Feb 2025 18:07:02 GMT) Full text and rfc822 format available.

Message #35 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Daniel K <d.khodabakhsh <at> gmail.com>
To: Jelle Licht <jlicht <at> fsfe.org>,
 Ludovic Courtès <ludo <at> gnu.org>
Cc: 74900 <at> debbugs.gnu.org
Subject: Re: [bug#74900] [PATCH 1/2] Replace (guix build json) with (json) in node-build-system
Date: Sun, 02 Feb 2025 02:06:00 +0800
Hi Ludo and Jelle,

Thanks for your interest and notes!

>Daniel, do you still see yourself working on this to get it
>upstreamed in the near future? If not, that is also perfectly fine of
>course :)

Sure thing! I tried to implement Ludo's note but I'm away from home for a few weeks with my laptop and it's having issues with guix pull (and also guix build) because it has a riscv64 CPU https://issues.guix.gnu.org/72774
I will be back to my x86_64 machine around February 15




Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:02 GMT) Full text and rfc822 format available.

Message #38 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: jlicht <at> fsfe.org, d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 1/6] build-system/node: Switch to (json).
Date: Tue, 18 Feb 2025 00:43:52 +0100
From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>

Replace (guix build json) with (json) in node-build-system

* guix/build/node-build-system.scm
(jsobject-ref, jsobject-update, jsobject-union, newest,
unkeyed->keyed): Remove unused functions.
(with-atomic-json-file-replacement): Switch to (json) module.  Move
file argument as a second optional argument.
(alist-update): Switch to (json) module.  Remove optional default
argument.
(patch-dependencies, delete-dependencies, build): Switch to (json)
module.  Arguments are unchanged.

* guix/build-system/node.scm (%node-build-system-modules): Switch
to (json) module.

* gnu/packages/node-xyz.scm (node-acorn, node-addon-api,
node-serialport-bindings, node-sqlite3): Adapt package custom
<#:phases> to the replacement.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I9fd5152a98b6a241d414e9a94ab179c9cabcfb85
---
 gnu/packages/node-xyz.scm        | 148 ++++++++++++-------------
 guix/build-system/node.scm       |   6 +-
 guix/build/node-build-system.scm | 180 ++++++++++++-------------------
 3 files changed, 139 insertions(+), 195 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index bbdcbb2b78..84adde9e50 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Dhruvin Gandhi <contact <at> dhruvin.dev>
 ;;; Copyright © 2022 Nicolas Graves <ngraves <at> ngraves.fr>
 ;;; Copyright © 2023 Jelle Licht <jlicht <at> fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,14 +25,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages node-xyz)
-  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (gnu packages sqlite)
   #:use-module (gnu packages python)
   #:use-module (gnu packages web)
+  #:use-module (guix build-system node)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix git-download)
-  #:use-module (guix build-system node))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix packages))
 
 ;;;
 ;;; Please: Try to add new module packages in alphabetic order.
@@ -69,19 +70,17 @@ (define-public node-acorn
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
              ;; TODO: Add utility function
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("prepare" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other other))
-                                pkg-meta-alist)))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("prepare" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist)))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -158,23 +157,17 @@ (define-public node-addon-api
            (lambda args
              (define new-test-script
                "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons
-                   '@
-                   (map (match-lambda
-                          (("scripts" '@ . scripts-alist)
-                           `("scripts" @ ,@(map (match-lambda
-                                                  (("test" . _)
-                                                   (cons "test"
-                                                         new-test-script))
-                                                  (other
-                                                   other))
-                                                scripts-alist)))
-                          (other
-                           other))
-                        pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (map
+                       (match-lambda
+                         (("test" . _) (cons "test" new-test-script))
+                         (other other))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -1223,22 +1216,19 @@ (define-public node-serialport-bindings
                                     "node-abi"))))
          (add-after 'chdir 'avoid-prebuild-install
            (lambda args
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (("gypfile" . _)
-                                   '("gypfile" . #f))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (("gypfile" . _)
+                     (cons "gypfile" #f))
+                   (other other))
+                 pkg-meta-alist))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1524,39 +1514,33 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement "package.json"
-               (match-lambda
-                 (('@ . pkg-meta-alist)
-                  (match (assoc-ref pkg-meta-alist "binary")
-                    (('@ . binary-alist)
-                     ;; When it builds from source, node-pre-gyp supplies
-                     ;; module_name and module_path based on the entries under
-                     ;; "binary" from "package.json", so this package's
-                     ;; "binding.gyp" doesn't define them. Thus, we also need
-                     ;; to supply them. The GYP_DEFINES environment variable
-                     ;; turns out to be the easiest way to make sure they are
-                     ;; propagated from npm to node-gyp to gyp.
-                     (setenv "GYP_DEFINES"
-                             (string-append
-                              "module_name="
-                              (assoc-ref binary-alist "module_name")
-                              " "
-                              "module_path="
-                              (assoc-ref binary-alist "module_path")))))
-                  ;; We need to remove the install script from "package.json",
-                  ;; as it would try to use node-pre-gyp and would block the
-                  ;; automatic building performed by `npm install`.
-                  (cons '@ (map (match-lambda
-                                  (("scripts" @ . scripts-alist)
-                                   `("scripts" @ ,@(filter (match-lambda
-                                                             (("install" . _)
-                                                              #f)
-                                                             (_
-                                                              #t))
-                                                           scripts-alist)))
-                                  (other
-                                   other))
-                                pkg-meta-alist))))))))))
+             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
+               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+                 ;; When it builds from source, node-pre-gyp supplies
+                 ;; module_name and module_path based on the entries under
+                 ;; "binary" from "package.json", so this package's
+                 ;; "binding.gyp" doesn't define them. Thus, we also need
+                 ;; to supply them. The GYP_DEFINES environment variable
+                 ;; turns out to be the easiest way to make sure they are
+                 ;; propagated from npm to node-gyp to gyp.
+                 (setenv "GYP_DEFINES" (string-append
+                   "module_name="
+                   (assoc-ref binary-alist "module_name")
+                   " module_path="
+                   (assoc-ref binary-alist "module_path"))))
+               ;; We need to remove the install script from "package.json",
+               ;; as it would try to use node-pre-gyp and would block the
+               ;; automatic building performed by `npm install`.
+               (map
+                 (match-lambda
+                   (("scripts" . scripts-alist)
+                     (cons "scripts" (filter
+                       (match-lambda
+                         (("install" . _) #f)
+                         (_ #t))
+                       scripts-alist)))
+                   (other other))
+                 pkg-meta-alist))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 57fe5f6030..425b8cd9b3 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
 ;;; Copyright © 2021 Philip McGrath <philip <at> philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,10 @@ (define-module (guix build-system node)
 (define %node-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build node-build-system)
-    (guix build json)
+    (json)
+    (json builder)
+    (json parser)
+    (json record)
     ,@%default-gnu-imported-modules))
 
 (define (default-node)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index fb23894bc1..df7ea7774c 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019, 2021 Timothy Sample <samplet <at> ngyro.com>
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler <at> gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,10 +24,10 @@
 (define-module (guix build node-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
-  #:use-module (guix build json)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
@@ -34,13 +35,14 @@ (define-module (guix build node-build-system)
             delete-dependencies
             node-build))
 
-(define (with-atomic-json-file-replacement file proc)
+(define* (with-atomic-json-file-replacement proc
+  #:optional (file "package.json"))
   "Like 'with-atomic-file-replacement', but PROC is called with a single
 argument---the result of parsing FILE's contents as json---and should a value
 to be written as json to the replacement FILE."
   (with-atomic-file-replacement file
     (lambda (in out)
-      (write-json (proc (read-json in)) out))))
+      (scm->json (proc (json->scm in)) out))))
 
 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -48,10 +50,6 @@ (define* (assoc-ref* alist key #:optional default)
     (#f default)
     ((_ . value) value)))
 
-(define* (jsobject-ref obj key #:optional default)
-  (match obj
-    (('@ . alist) (assoc-ref* alist key default))))
-
 (define* (alist-pop alist key #:optional (= equal?))
   "Return two values, the first pair in ALIST with key KEY, and the other
 elements.  Equality calls are made as (= KEY ALISTCAR)."
@@ -63,67 +61,17 @@ (define (found? pair)
         (values (car after) (append before (cdr after)))
         (values #f before))))
 
-(define* (alist-update alist key proc #:optional default (= equal?))
+(define* (alist-update alist key proc #:optional (= equal?))
   "Return an association list like ALIST, but with KEY mapped to the result of
 PROC applied to the first value found under the comparison (= KEY ALISTCAR).
-If no such value exists, use DEFAULT instead.
+If no such value exists, return the list unchanged.
 Unlike acons, this removes the previous association of KEY (assuming it is
 unique), but the result may still share storage with ALIST."
   (let ((pair rest (alist-pop alist key =)))
-    (acons key
-           (proc (if (pair? pair)
-                     (cdr pair)
-                     default))
-           rest)))
+    (if (pair? pair)
+      (acons key (proc (cdr pair)) rest)
+      alist)))
 
-(define (jsobject-update* js . updates)
-  "Return a json object like JS, but with all UPDATES applied.  Each update is
-a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of PROC
-applied to the value to which KEY is mapped in JS.  If no such mapping exists,
-PROC is instead applied to DEFAULT, or to '#f' is no DEFAULT is specified.
-The update takes place from left to right, so later UPDATERs will receive the
-values returned by earlier UPDATERs for the same KEY."
-  (match js
-    (('@ . alist)
-     (let loop ((alist alist)
-                (updates updates))
-       (match updates
-         (() (cons '@ alist))
-         (((key proc) . updates)
-          (loop (alist-update alist key proc #f equal?) updates))
-         (((key proc default) . updates)
-          (loop (alist-update alist key proc default equal?) updates)))))))
-
-(define (jsobject-union combine seed . objects)
-  "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0
-is the value found in the (possibly updated) SEED and VAL is the new value
-found in one of the OBJECTS."
-  (match seed
-    (('@ . aseed)
-     (match objects
-       (() seed)
-       ((('@ . alists) ...)
-        (cons
-         '@
-         (fold (lambda (alist aseed)
-                 (if (null? aseed) alist
-                     (fold
-                      (match-lambda*
-                        (((k . v) aseed)
-                         (let ((pair tail (alist-pop alist k)))
-                           (match pair
-                             (#f (acons k v aseed))
-                             ((_ . v0) (acons k (combine k v0 v) aseed))))))
-                      aseed
-                      alist)))
-               aseed
-               alists)))))))
-
-;; Possibly useful helper functions:
-;; (define (newest key val0 val) val)
-;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val)))
-
-
 ;;;
 ;;; Phases.
 ;;;
@@ -142,8 +90,8 @@ (define (set-home . _)
 
 (define (module-name module)
   (let* ((package.json (string-append module "/package.json"))
-         (package-meta (call-with-input-file package.json read-json)))
-    (jsobject-ref package-meta "name")))
+         (package-meta (call-with-input-file package.json json->scm)))
+    (assoc-ref package-meta "name")))
 
 (define (index-modules input-paths)
   (define (list-modules directory)
@@ -167,49 +115,59 @@ (define* (patch-dependencies #:key inputs #:allow-other-keys)
 
   (define index (index-modules (map cdr inputs)))
 
-  (define resolve-dependencies
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (map (match-lambda
-                       ((key . value)
-                        (cons key (hash-ref index key value))))
-                     alist)))))
+  (define (resolve-dependencies dependencies)
+    (map
+      (match-lambda
+        ((dependency . version)
+          (cons dependency (hash-ref index dependency version))))
+      dependencies))
 
-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,resolve-dependencies (@))
-       `("dependencies" ,(lambda (deps)
-                           (resolve-dependencies
-                            (jsobject-union
-                             (lambda (k a b) b)
-                             (jsobject-ref pkg-meta "peerDependencies" '(@))
-                             deps)))
-         (@)))))
+      (fold
+        (lambda (proc pkg-meta) (proc pkg-meta))
+        pkg-meta
+        (list
+          (lambda (pkg-meta)
+            (alist-update pkg-meta "devDependencies" resolve-dependencies))
+          (lambda (pkg-meta)
+            (assoc-set!
+              pkg-meta
+              "dependencies"
+              (resolve-dependencies
+                ; Combined "peerDependencies" and "dependencies" dependencies
+                ; with "dependencies" taking precedent.
+                (fold
+                  (lambda (dependency dependencies)
+                    (assoc-set! dependencies (car dependency) (cdr dependency)))
+                  (assoc-ref* pkg-meta "peerDependencies" '())
+                  (assoc-ref* pkg-meta "dependencies" '())))))))))
   #t)
 
-(define (delete-dependencies absent)
+(define (delete-dependencies dependencies-to-remove)
   "Rewrite 'package.json' to allow the build to proceed without packages
-listed in ABSENT, a list of strings naming npm packages.
+listed in 'dependencies-to-remove', a list of strings naming npm packages.
 
 To prevent the deleted dependencies from being reintroduced, use this function
 only after the 'patch-dependencies' phase."
-  (define delete-from-jsobject
-    (match-lambda
-      (('@ . alist)
-       (cons '@ (filter (match-lambda
-                          ((k . _)
-                           (not (member k absent))))
-                        alist)))))
-
-  (with-atomic-json-file-replacement "package.json"
+  (with-atomic-json-file-replacement
     (lambda (pkg-meta)
-      (jsobject-update*
-       pkg-meta
-       `("devDependencies" ,delete-from-jsobject (@))
-       `("dependencies" ,delete-from-jsobject (@))
-       `("peerDependencies" ,delete-from-jsobject (@))))))
+      (fold
+        (lambda (dependency-key pkg-meta)
+          (alist-update
+            pkg-meta
+            dependency-key
+            (lambda (dependencies)
+              (remove
+                (lambda (dependency)
+                  (member (car dependency) dependencies-to-remove))
+                dependencies))))
+        pkg-meta
+        (list
+          "devDependencies"
+          "dependencies"
+          "peerDependencies"
+          "optionalDependencies")))))
 
 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
@@ -228,8 +186,8 @@ (define* (configure #:key outputs inputs #:allow-other-keys)
     #t))
 
 (define* (build #:key inputs #:allow-other-keys)
-  (let ((package-meta (call-with-input-file "package.json" read-json)))
-    (if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f)
+  (let ((package-meta (call-with-input-file "package.json" json->scm)))
+    (if (assoc-ref* (assoc-ref* package-meta "scripts" '()) "build" #f)
         (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
           (invoke npm "run" "build"))
         (format #t "there is no build script to run~%"))
@@ -301,22 +259,20 @@ (define installed-package.json
   ;; even need to overwrite this file.  Therefore, let's use some helpers
   ;; that we'd otherwise not need.
   (define pkg-meta
-    (call-with-input-file installed-package.json read-json))
+    (call-with-input-file installed-package.json json->scm))
   (define scripts
-    (jsobject-ref pkg-meta "scripts" '(@)))
-  (define (jsobject-set js key val)
-    (jsobject-update* js (list key (const val))))
+    (assoc-ref* pkg-meta "scripts" '()))
 
-  (when (equal? "node-gyp rebuild" (jsobject-ref scripts "install" #f))
+  (when (equal? "node-gyp rebuild" (assoc-ref* scripts "install" #f))
     (call-with-output-file installed-package.json
       (lambda (out)
-        (write-json
-         (jsobject-set pkg-meta
-                       "scripts"
-                       (jsobject-set scripts
-                                     "install"
-                                     "echo Guix: avoiding node-gyp rebuild"))
-         out)))))
+        (scm->json
+          (assoc-set! pkg-meta
+                      "scripts"
+                      (assoc-set! scripts
+                                  "install"
+                                  "echo Guix: avoiding node-gyp rebuild"))
+          out)))))
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
-- 
2.48.1





Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:02 GMT) Full text and rfc822 format available.

Message #41 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: jlicht <at> fsfe.org, d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 2/6] build-system/node: New API for modifying json.
Date: Tue, 18 Feb 2025 00:43:53 +0100
From: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>

Introduce (modify-json), (delete-fields), and (replace-fields) to node-build-system

This change introduces helper procedures (modify-json) which takes in lambdas
 which modify the target json #:file which defaults to package.json
This change also includes (delete-fields) and (replace-fields) to help deleting
 and replacing the value of fields in a package.json file.

* guix/build/node-build-system.scm
(modify-json, modify-json-fields, delete-fields, replace-fields,
delete-dev-dependencies): New API exported procedures.
(with-atomic-json-file-replacement, delete-dependencies): Change
procedures to adapt to the new API.

* gnu/packages/node.scm (node-ms-bootstrap,
node-binary-search-bootstrap, node-debug-boostrap,
node-llparse-builder-bootstrap, node-llparse-frontend-boostrap,
node-llparse-bootstrap): Use new API procedures.

* gnu/packages/node-xyz.scm (node-acorn, node-addon-api,
node-buffer-crc32, node-crx3, node-debug, node-file-uri-to-path,
node-ieee754, node-inherits, node-irc, node-irc-colors, node-minimist,
node-ms, node-nan, node-normalize-path, node-once, node-path-key,
node-pbf, node-protocol-buffers-schema, node-readable-stream,
node-resolve-protobuf-schema, node-safe-buffer,
node-safe-stable-stringify, node-semver, node-serialport,
node-serialport-bindings, node-serialport-stream, node-sqlite3,
node-string-decoder, node-tiddlywiki, node-wrappy, node-yazl): Use new
API procedures.

Signed-off-by: Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
Change-Id: I957f7ca814078d2136d5261985174820235f1369
---
 gnu/packages/node-xyz.scm        | 395 ++++++++++++++-----------------
 gnu/packages/node.scm            |  86 +++----
 guix/build/node-build-system.scm | 198 +++++++++++++---
 3 files changed, 392 insertions(+), 287 deletions(-)

diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index 84adde9e50..54e3376e4e 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -69,18 +69,7 @@ (define-public node-acorn
              ;; We need to remove the prepare script from "package.json", as
              ;; it would try to use the build environment and would block the
              ;; automatic building by other packages making use of node-acorn.
-             ;; TODO: Add utility function
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (filter
-                       (match-lambda
-                         (("prepare" . _) #f)
-                         (_ #t))
-                       scripts-alist)))
-                   (other other))
-                 pkg-meta-alist)))))
+             (modify-json (delete-fields '(("scripts" "prepare"))))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((esbuild (search-input-file (or native-inputs inputs)
@@ -136,38 +125,25 @@ (define-public node-addon-api
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              `("benchmark"
-                "bindings"
-                "clang-format"
-                "eslint"
-                "eslint-config-semistandard"
-                "eslint-config-standard"
-                "eslint-plugin-import"
-                "eslint-plugin-node"
-                "eslint-plugin-promise"
-                "fs-extra"
-                "neostandard"
-                "path"
-                "pre-commit"
-                "semver"))))
-         (add-after 'unpack 'skip-js-tests
-           ;; We can't run the js-based tests,
-           ;; but we can still do the C++ parts
-           (lambda args
-             (define new-test-script
-               "echo stopping after pretest on Guix")
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (map
-                       (match-lambda
-                         (("test" . _) (cons "test" new-test-script))
-                         (other other))
-                       scripts-alist)))
-                   (other other))
-                 pkg-meta-alist))))))))
+             (modify-json (delete-dependencies
+                           `("benchmark"
+                             "bindings"
+                             "clang-format"
+                             "eslint"
+                             "eslint-config-semistandard"
+                             "eslint-config-standard"
+                             "eslint-plugin-import"
+                             "eslint-plugin-node"
+                             "eslint-plugin-promise"
+                             "fs-extra"
+                             "neostandard"
+                             "path"
+                             "pre-commit"
+                             "semver"))
+               ;; We can't run the js-based tests,
+               ;; but we can still do the C++ parts
+               (replace-fields (list (cons
+                 "scripts.test" "echo stopping after pretest on Guix")))))))))
     (home-page "https://github.com/nodejs/node-addon-api")
     (synopsis "Node.js API (Node-API) header-only C++ wrappers")
     (description "This module contains header-only C++ wrapper classes which
@@ -232,7 +208,7 @@ (define-public node-buffer-crc32
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("tap")))))))
+                      (modify-json (delete-dependencies '("tap"))))))))
     (home-page "https://github.com/brianloveswords/buffer-crc32")
     (synopsis "CRC32 implementation in Javascript")
     (description
@@ -288,14 +264,15 @@ (define-public node-crx3
                          "minimist"))))
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("c8"
-                                             "docdash"
-                                             "eslint"
-                                             "eslint-plugin-jsdoc"
-                                             "jsdoc"
-                                             "tap-diff"
-                                             "tape"
-                                             "tape-catch")))))))
+                      (modify-json (delete-dependencies
+                                    '("c8"
+                                      "docdash"
+                                      "eslint"
+                                      "eslint-plugin-jsdoc"
+                                      "jsdoc"
+                                      "tap-diff"
+                                      "tape"
+                                      "tape-catch"))))))))
     (inputs (list node-minimist node-pbf node-yazl))
     (home-page "https://github.com/ahwayakchih/crx3")
     (synopsis "Create CRXv3 browser extensions with Javascript")
@@ -325,18 +302,19 @@ (define-public node-debug
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("brfs"
-                                    "browserify"
-                                    "coveralls"
-                                    "istanbul"
-                                    "karma"
-                                    "karma-browserify"
-                                    "karma-chrome-launcher"
-                                    "karma-mocha"
-                                    "mocha"
-                                    "mocha-lcov-reporter"
-                                    "xo"
-                                    "supports-color")))))
+             (modify-json (delete-dependencies
+                           `("brfs"
+                             "browserify"
+                             "coveralls"
+                             "istanbul"
+                             "karma"
+                             "karma-browserify"
+                             "karma-chrome-launcher"
+                             "karma-mocha"
+                             "mocha"
+                             "mocha-lcov-reporter"
+                             "xo"
+                             "supports-color"))))))
        #:tests? #f))
     (home-page "https://github.com/debug-js/debug")
     (synopsis "Debugging utility for Node.js")
@@ -421,21 +399,22 @@ (define-public node-file-uri-to-path
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@types/mocha"
-                                    "@types/node"
-                                    "@typescript-eslint/eslint-plugin"
-                                    "@typescript-eslint/parser"
-                                    "cpy-cli"
-                                    "eslint"
-                                    "eslint-config-airbnb"
-                                    "eslint-config-prettier"
-                                    "eslint-import-resolver-typescript"
-                                    "eslint-plugin-import"
-                                    "eslint-plugin-jsx-a11y"
-                                    "eslint-plugin-react"
-                                    "mocha"
-                                    "rimraf"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+                           `("@types/mocha"
+                             "@types/node"
+                             "@typescript-eslint/eslint-plugin"
+                             "@typescript-eslint/parser"
+                             "cpy-cli"
+                             "eslint"
+                             "eslint-config-airbnb"
+                             "eslint-config-prettier"
+                             "eslint-import-resolver-typescript"
+                             "eslint-plugin-import"
+                             "eslint-plugin-jsx-a11y"
+                             "eslint-plugin-react"
+                             "mocha"
+                             "rimraf"
+                             "typescript")))))
          (replace 'build
            (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (copy-recursively "src" "dist")
@@ -497,7 +476,9 @@ (define-public node-ieee754
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("airtap" "standard" "tape")))))))
+                      (modify-json
+                       (delete-dependencies
+                        '("airtap" "standard" "tape"))))))))
     (home-page "https://github.com/feross/ieee754")
     (synopsis "Read/write IEEE754 floating point numbers in Javascript")
     (description "This package can read and write IEEE754 floating point
@@ -524,7 +505,7 @@ (define-public node-inherits
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))
+             (modify-json (delete-dependencies '("tap"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (home-page "https://github.com/isaacs/inherits")
@@ -553,8 +534,9 @@ (define-public node-irc
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              `("ansi-color" "faucet" "jscs" "tape")))))
+             (modify-json
+              (delete-dependencies
+               `("ansi-color" "faucet" "jscs" "tape"))))))
        #:tests? #f))
     (inputs
      (list node-irc-colors))
@@ -583,7 +565,7 @@ (define-public node-irc-colors
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("istanbul" "vows")))))
+             (modify-json (delete-dependencies `("istanbul" "vows"))))))
        #:tests? #f))
     (home-page "https://github.com/fent/irc-colors.js")
     (synopsis "Node.js module providing color and formatting for IRC")
@@ -657,7 +639,8 @@ (define-public node-minimist
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("covert" "tap" "tape")))))))
+                      (modify-json (delete-dependencies
+                                    '("covert" "tap" "tape"))))))))
     (home-page "https://github.com/substack/minimist")
     (synopsis "Parse CLI arguments in Javascript")
     (description "This package can scan for CLI flags and arguments in
@@ -683,12 +666,13 @@ (define-public node-ms
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("eslint"
-                                    "expect.js"
-                                    "husky"
-                                    "lint-staged"
-                                    "mocha"
-                                    "prettier")))))
+             (modify-json (delete-dependencies
+                           `("eslint"
+                             "expect.js"
+                             "husky"
+                             "lint-staged"
+                             "mocha"
+                             "prettier"))))))
        #:tests? #f))
     (home-page "https://github.com/vercel/ms")
     (synopsis "Convert time to milliseconds")
@@ -716,14 +700,14 @@ (define-public node-nan
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              '("bindings"
-                "commander"
-                "glob"
-                "request"
-                "node-gyp" ;; would be needed for tests
-                "tap"
-                "xtend")))))
+             (modify-json (delete-dependencies
+                           '("bindings"
+                             "commander"
+                             "glob"
+                             "request"
+                             "node-gyp" ;; would be needed for tests
+                             "tap"
+                             "xtend"))))))
        ;; tests need tap and other dependencies
        #:tests? #f))
     (inputs
@@ -755,7 +739,8 @@ (define-public node-normalize-path
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("gulp-format-md" "mocha")))))))
+                      (modify-json (delete-dependencies
+                                    '("gulp-format-md" "mocha"))))))))
     (native-inputs (list node-minimist))
     (home-page "https://github.com/jonschlinkert/normalize-path")
     (synopsis "Normalize slashes in a file path")
@@ -784,7 +769,7 @@ (define-public node-once
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))
+             (modify-json (delete-dependencies '("tap"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (inputs
@@ -841,7 +826,9 @@ (define-public node-path-key
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("@types/node" "ava" "tsd" "xo")))))))
+                      (modify-json
+                       (delete-dependencies
+                        '("@types/node" "ava" "tsd" "xo"))))))))
     (home-page "https://github.com/sindresorhus/path-key")
     (synopsis "Cross-platform utility to compute the PATH environment variable key")
     (description "@code{path-key} provides an implementation to compute the
@@ -867,17 +854,17 @@ (define-public node-pbf
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies
-                       '("benchmark"
-                         "browserify"
-                         "eslint"
-                         "eslint-config-mourner"
-                         "mkdirp"
-                         "protobufjs"
-                         "protocol-buffers"
-                         "tap"
-                         "tile-stats-runner"
-                         "uglify-js")))))))
+                      (modify-json (delete-dependencies
+                                    '("benchmark"
+                                      "browserify"
+                                      "eslint"
+                                      "eslint-config-mourner"
+                                      "mkdirp"
+                                      "protobufjs"
+                                      "protocol-buffers"
+                                      "tap"
+                                      "tile-stats-runner"
+                                      "uglify-js"))))))))
     (inputs (list node-ieee754 node-resolve-protobuf-schema))
     (home-page "https://github.com/mapbox/pbf")
     (synopsis "Decode and encode protocol buffers in Javascript")
@@ -908,7 +895,8 @@ (define-public node-protocol-buffers-schema
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("standard" "tape")))))))
+                      (modify-json (delete-dependencies
+                                    '("standard" "tape"))))))))
     (home-page "https://github.com/mafintosh/protocol-buffers-schema")
     (synopsis "Protocol buffers schema parser written in Javascript")
     (description "This package provides a protocol buffers schema parser
@@ -935,26 +923,27 @@ (define-public node-readable-stream
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@babel/cli"
-                                    "@babel/core"
-                                    "@babel/polyfill"
-                                    "@babel/preset-env"
-                                    "airtap"
-                                    "assert"
-                                    "bl"
-                                    "deep-strict-equal"
-                                    "events.once"
-                                    "glob"
-                                    "gunzip-maybe"
-                                    "hyperquest"
-                                    "lolex"
-                                    "nyc"
-                                    "pump"
-                                    "rimraf"
-                                    "tap"
-                                    "tape"
-                                    "tar-fs"
-                                    "util-promisify")))))
+             (modify-json (delete-dependencies
+                           `("@babel/cli"
+                             "@babel/core"
+                             "@babel/polyfill"
+                             "@babel/preset-env"
+                             "airtap"
+                             "assert"
+                             "bl"
+                             "deep-strict-equal"
+                             "events.once"
+                             "glob"
+                             "gunzip-maybe"
+                             "hyperquest"
+                             "lolex"
+                             "nyc"
+                             "pump"
+                             "rimraf"
+                             "tap"
+                             "tape"
+                             "tar-fs"
+                             "util-promisify"))))))
        #:tests? #f))
     (inputs (list node-util-deprecate node-string-decoder node-inherits))
     (home-page "https://github.com/nodejs/readable-stream")
@@ -983,7 +972,8 @@ (define-public node-resolve-protobuf-schema
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("standard" "tape")))))))
+                      (modify-json (delete-dependencies
+                                    '("standard" "tape"))))))))
     (inputs (list node-protocol-buffers-schema))
     (home-page "https://github.com/mafintosh/resolve-protobuf-schema")
     (synopsis "Resolve protobuf imports")
@@ -1012,7 +1002,7 @@ (define-public node-safe-buffer
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tape" "standard")))))
+             (modify-json (delete-dependencies '("tape" "standard"))))))
        #:tests? #f))
     (home-page "https://github.com/feross/safe-buffer")
     (synopsis "Buffer creation with explicit semantics")
@@ -1040,20 +1030,22 @@ (define-public node-safe-stable-stringify
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("benchmark" "clone"
-                                             "fast-json-stable-stringify"
-                                             "fast-safe-stringify"
-                                             "fast-stable-stringify"
-                                             "faster-stable-stringify"
-                                             "fastest-stable-stringify"
-                                             "json-stable-stringify"
-                                             "json-stringify-deterministic"
-                                             "json-stringify-safe"
-                                             "standard"
-                                             "tap"
-                                             "typescript"
-                                             "@types/node"
-                                             "@types/json-stable-stringify")))))))
+                      (modify-json (delete-dependencies
+                                    '("benchmark"
+                                      "clone"
+                                      "fast-json-stable-stringify"
+                                      "fast-safe-stringify"
+                                      "fast-stable-stringify"
+                                      "faster-stable-stringify"
+                                      "fastest-stable-stringify"
+                                      "json-stable-stringify"
+                                      "json-stringify-deterministic"
+                                      "json-stringify-safe"
+                                      "standard"
+                                      "tap"
+                                      "typescript"
+                                      "@types/node"
+                                      "@types/json-stable-stringify"))))))))
     (home-page "https://github.com/BridgeAR/safe-stable-stringify")
     (synopsis "Serialization of javascript objects")
     (description
@@ -1111,7 +1103,7 @@ (define-public node-semver
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))
+             (modify-json (delete-dependencies '("tap"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (home-page "https://github.com/npm/node-semver")
@@ -1151,7 +1143,8 @@ (define-public node-serialport
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@serialport/binding-mock"))))
+             (modify-json (delete-dependencies
+                           `("@serialport/binding-mock")))))
          (add-after 'unpack 'chdir
            (lambda args
              (chdir "packages/serialport"))))
@@ -1210,25 +1203,7 @@ (define-public node-serialport-bindings
              (chdir "packages/bindings")))
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("prebuild-install"
-                                    ;; devDependencies
-                                    "@serialport/binding-mock"
-                                    "node-abi"))))
-         (add-after 'chdir 'avoid-prebuild-install
-           (lambda args
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (filter
-                       (match-lambda
-                         (("install" . _) #f)
-                         (_ #t))
-                       scripts-alist)))
-                   (("gypfile" . _)
-                     (cons "gypfile" #f))
-                   (other other))
-                 pkg-meta-alist))))))
+             (modify-json (delete-dependencies `("node-abi"))))))
        #:tests? #f))
     (synopsis "Abstract base class for Node SerialPort bindings")
     (description "Node SerialPort is a modular suite of Node.js packages for
@@ -1409,8 +1384,8 @@ (define-public node-serialport-stream
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `(;; devDependencies
-                                    "@serialport/binding-mock"))))
+             (modify-json
+               (delete-dependencies `("@serialport/binding-mock")))))
          (add-after 'unpack 'chdir
            (lambda args
              (chdir "packages/stream"))))
@@ -1461,26 +1436,27 @@ (define-public node-sqlite3
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              `(;; Normally, this is "built" using @mapbox/node-pre-gyp,
-                ;; which publishes or downloads pre-built binaries or
-                ;; falls back to building from source.  Here, we patch out
-                ;; all of that and just build directly.  It might be
-                ;; better to patch a version of @mapbox/node-pre-gyp that
-                ;; always builds from source, as Debian does, but there
-                ;; are a number of dependencies that need to be packaged
-                ;; or removed.
-                "@mapbox/node-pre-gyp"
-                "node-pre-gyp" ;; deprecated name still used in some places
-                "aws-sdk"
-                "@mapbox/cloudfriend"
-                ;; Confusingly, this is only a dependency because of
-                ;; @mapbox/node-pre-gyp: with that removed,
-                ;; npm will use its own copy:
-                "node-gyp"
-                ;; These we'd like, we just don't have them yet:
-                "eslint"
-                "mocha"))))
+             (modify-json
+              (delete-dependencies
+               `(;; Normally, this is "built" using @mapbox/node-pre-gyp,
+                 ;; which publishes or downloads pre-built binaries or
+                 ;; falls back to building from source.  Here, we patch out
+                 ;; all of that and just build directly.  It might be
+                 ;; better to patch a version of @mapbox/node-pre-gyp that
+                 ;; always builds from source, as Debian does, but there
+                 ;; are a number of dependencies that need to be packaged
+                 ;; or removed.
+                 "@mapbox/node-pre-gyp"
+                 "node-pre-gyp" ;; deprecated name still used in some places
+                 "aws-sdk"
+                 "@mapbox/cloudfriend"
+                 ;; Confusingly, this is only a dependency because of
+                 ;; @mapbox/node-pre-gyp: with that removed,
+                 ;; npm will use its own copy:
+                 "node-gyp"
+                 ;; These we'd like, we just don't have them yet:
+                 "eslint"
+                 "mocha")))))
          (add-before 'configure 'npm-config-sqlite
            ;; We need this step even if we do replace @mapbox/node-pre-gyp
            ;; because the package expects to build its bundled sqlite
@@ -1514,8 +1490,9 @@ (define-public node-sqlite3
              (substitute* ".npmignore"
                (("lib/binding")
                 "#lib/binding # <- patched for Guix"))
-             (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
-               (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
+             (modify-json
+               (lambda (pkg-meta-alist)
+                 (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
                  ;; When it builds from source, node-pre-gyp supplies
                  ;; module_name and module_path based on the entries under
                  ;; "binary" from "package.json", so this package's
@@ -1528,19 +1505,11 @@ (define-public node-sqlite3
                    (assoc-ref binary-alist "module_name")
                    " module_path="
                    (assoc-ref binary-alist "module_path"))))
+                 pkg-meta-alist)
                ;; We need to remove the install script from "package.json",
                ;; as it would try to use node-pre-gyp and would block the
                ;; automatic building performed by `npm install`.
-               (map
-                 (match-lambda
-                   (("scripts" . scripts-alist)
-                     (cons "scripts" (filter
-                       (match-lambda
-                         (("install" . _) #f)
-                         (_ #t))
-                       scripts-alist)))
-                   (other other))
-                 pkg-meta-alist))))))))
+               (delete-fields `(("scripts" "install")))))))))
     (home-page "https://github.com/mapbox/node-sqlite3")
     (synopsis "Node.js bindings for SQLite3")
     (description
@@ -1623,8 +1592,9 @@ (define-public node-string-decoder
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies
-              '("tap" "core-util-is" "babel-polyfill")))))
+             (modify-json
+              (delete-dependencies
+               '("tap" "core-util-is" "babel-polyfill"))))))
        ;; FIXME: Tests depend on node-tap
        #:tests? #f))
     (inputs (list node-safe-buffer node-inherits))
@@ -1656,7 +1626,8 @@ (define-public node-tiddlywiki
                    (delete 'build)
                    (add-after 'patch-dependencies 'delete-dev-dependencies
                      (lambda _
-                       (delete-dependencies '("eslint" "@eslint/js")))))))
+                       (modify-json
+                        (delete-dependencies '("eslint" "@eslint/js"))))))))
     (home-page "https://github.com/TiddlyWiki/TiddlyWiki5#readme")
     (synopsis "Non-linear personal web notebook")
     (description "TiddlyWiki is a unique non-linear notebook for capturing,
@@ -1714,7 +1685,7 @@ (define-public node-wrappy
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))))
+             (modify-json (delete-dependencies '("tap"))))))))
     (home-page "https://github.com/npm/wrappy")
     (synopsis "Callback wrapping utility")
     (description "@code{wrappy} is a utility for Node.js to wrap callbacks.")
@@ -1739,7 +1710,9 @@ (define-public node-yazl
        #:phases (modify-phases %standard-phases
                   (add-after 'patch-dependencies 'delete-dependencies
                     (lambda _
-                      (delete-dependencies '("airtap" "bl" "istanbul" "yauzl")))))))
+                      (modify-json
+                       (delete-dependencies
+                        '("airtap" "bl" "istanbul" "yauzl"))))))))
     (inputs (list node-buffer-crc32))
     (home-page "https://github.com/thejoshwolfe/yazl")
     (synopsis "Yet another zip library for node")
diff --git a/gnu/packages/node.scm b/gnu/packages/node.scm
index 75a1a12c53..6d6768e590 100644
--- a/gnu/packages/node.scm
+++ b/gnu/packages/node.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2021, 2022 Philip McGrath <philip <at> philipmcgrath.com>
 ;;; Copyright © 2022 Hilton Chain <hako <at> ultrarare.space>
 ;;; Copyright © 2024 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -366,7 +367,7 @@ (define-public node-semver-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("tap")))))))
+             (modify-json (delete-dependencies '("tap"))))))))
     (home-page "https://github.com/npm/node-semver")
     (properties '((hidden? . #t)))
     (synopsis "Parses semantic versions strings")
@@ -397,11 +398,12 @@ (define-public node-ms-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies '("eslint"
-                                    "expect.js"
-                                    "husky"
-                                    "lint-staged"
-                                    "mocha")))))))
+             (modify-json (delete-dependencies
+                           '("eslint"
+                             "expect.js"
+                             "husky"
+                             "lint-staged"
+                             "mocha"))))))))
     (home-page "https://github.com/zeit/ms#readme")
     (properties '((hidden? . #t)))
     (synopsis "Tiny millisecond conversion utility")
@@ -431,7 +433,7 @@ (define-public node-binary-search-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("chai" "mocha")))))))
+             (modify-json (delete-dependencies `("chai" "mocha"))))))))
     (home-page "https://github.com/darkskyapp/binary-search#readme")
     (properties '((hidden? . #t)))
     (synopsis "Tiny binary search function with comparators")
@@ -460,17 +462,18 @@ (define-public node-debug-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("brfs"
-                                    "browserify"
-                                    "coveralls"
-                                    "istanbul"
-                                    "karma"
-                                    "karma-browserify"
-                                    "karma-chrome-launcher"
-                                    "karma-mocha"
-                                    "mocha"
-                                    "mocha-lcov-reporter"
-                                    "xo")))))))
+             (modify-json (delete-dependencies
+                           `("brfs"
+                             "browserify"
+                             "coveralls"
+                             "istanbul"
+                             "karma"
+                             "karma-browserify"
+                             "karma-chrome-launcher"
+                             "karma-mocha"
+                             "mocha"
+                             "mocha-lcov-reporter"
+                             "xo"))))))))
     (inputs (list node-ms-bootstrap))
     (home-page "https://github.com/visionmedia/debug#readme")
     (properties '((hidden? . #t)))
@@ -526,12 +529,13 @@ (define-public node-llparse-builder-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda _
-             (delete-dependencies `("@types/mocha"
-                                    "@types/node"
-                                    "mocha"
-                                    "ts-node"
-                                    "tslint"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+                           `("@types/mocha"
+                             "@types/node"
+                             "mocha"
+                             "ts-node"
+                             "tslint"
+                             "typescript")))))
          (replace 'build
            (lambda* (#:key inputs #:allow-other-keys)
              (let ((esbuild (search-input-file inputs "/bin/esbuild")))
@@ -587,13 +591,14 @@ (define-public node-llparse-frontend-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@types/debug"
-                                    "@types/mocha"
-                                    "@types/node"
-                                    "mocha"
-                                    "ts-node"
-                                    "tslint"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+                           `("@types/debug"
+                             "@types/mocha"
+                             "@types/node"
+                             "mocha"
+                             "ts-node"
+                             "tslint"
+                             "typescript")))))
          (replace 'build
            (lambda* (#:key inputs #:allow-other-keys)
              (let ((esbuild (search-input-file inputs "/bin/esbuild")))
@@ -648,15 +653,16 @@ (define-public node-llparse-bootstrap
        (modify-phases %standard-phases
          (add-after 'patch-dependencies 'delete-dependencies
            (lambda args
-             (delete-dependencies `("@types/debug"
-                                    "@types/mocha"
-                                    "@types/node"
-                                    "esm"
-                                    "llparse-test-fixture"
-                                    "mocha"
-                                    "ts-node"
-                                    "tslint"
-                                    "typescript"))))
+             (modify-json (delete-dependencies
+                           `("@types/debug"
+                             "@types/mocha"
+                             "@types/node"
+                             "esm"
+                             "llparse-test-fixture"
+                             "mocha"
+                             "ts-node"
+                             "tslint"
+                             "typescript")))))
          (replace 'build
            (lambda* (#:key inputs #:allow-other-keys)
              (let ((esbuild (search-input-file inputs "/bin/esbuild")))
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index df7ea7774c..ea23d92a05 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -31,18 +31,14 @@ (define-module (guix build node-build-system)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
-            with-atomic-json-file-replacement
             delete-dependencies
-            node-build))
-
-(define* (with-atomic-json-file-replacement proc
-  #:optional (file "package.json"))
-  "Like 'with-atomic-file-replacement', but PROC is called with a single
-argument---the result of parsing FILE's contents as json---and should a value
-to be written as json to the replacement FILE."
-  (with-atomic-file-replacement file
-    (lambda (in out)
-      (scm->json (proc (json->scm in)) out))))
+            delete-dev-dependencies
+            delete-fields
+            modify-json
+            modify-json-fields
+            node-build
+            replace-fields
+            with-atomic-json-file-replacement))
 
 (define* (assoc-ref* alist key #:optional default)
   "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@@ -72,6 +68,161 @@ (define* (alist-update alist key proc #:optional (= equal?))
       (acons key (proc (cdr pair)) rest)
       alist)))
 
+;;;
+;;; package.json modification procedures
+;;;
+
+(define* (with-atomic-json-file-replacement proc
+  #:optional (file "package.json"))
+  "Like 'with-atomic-file-replacement', but PROC is called with a single
+argument---the result of parsing FILE's contents as json---and should a value
+to be written as json to the replacement FILE."
+  (with-atomic-file-replacement file
+    (lambda (in out)
+      (scm->json (proc (json->scm in)) out))))
+
+(define* (modify-json #:key (file "package.json") #:rest all-arguments)
+  "Provide package.json modifying callbacks such as (delete-dependencies ...)"
+  (let
+    (
+      (modifications
+        (let loop ((arguments all-arguments))
+          (cond
+            ((null? arguments) '())
+            ((keyword? (car arguments)) (loop (cddr arguments)))
+            (else (cons (car arguments) (loop (cdr arguments))))))))
+    (with-atomic-json-file-replacement
+      (lambda (package)
+        (fold
+          (lambda (modification package)
+            (modification package))
+          package
+          modifications))
+      file)))
+
+(define (delete-dependencies dependencies-to-remove)
+  "Rewrite 'package.json' to allow the build to proceed without packages
+listed in 'dependencies-to-remove', a list of strings naming npm packages.
+
+To prevent the deleted dependencies from being reintroduced, use this function
+only after the 'patch-dependencies' phase."
+  (lambda (pkg-meta)
+    (fold
+      (lambda (dependency-key pkg-meta)
+        (alist-update
+          pkg-meta
+          dependency-key
+          (lambda (dependencies)
+            (remove
+              (lambda (dependency)
+                (member (car dependency) dependencies-to-remove))
+              dependencies))))
+      pkg-meta
+      (list
+        "devDependencies"
+        "dependencies"
+        "peerDependencies"
+        "optionalDependencies"))))
+
+(define* (modify-json-fields
+    fields
+    field-modifier
+    #:key
+      (field-path-mapper (lambda (field) field))
+      (insert? #f)
+      (strict? #t))
+  "Provides a lambda to supply to modify-json which modifies the specified
+ json file.
+- `fields` is a list procedure-specific data structures which should include
+ the definition of a `field-path` in one of two syntaxes: dot-syntax string
+ such as `\"devDependencies.esbuild\"`, or a list of strings such as
+ `(list \"devDependencies\" \"esbuild\")`.
+- `field-modifier` is a lambda which is invoked at the position of the field.
+ It is supplied with the current field definition, the association list (alist)
+ at the field location in the json file, and the field name, also called `key`.
+- `field-path-mapper` is a lambda which instructs where the field-path is
+ located within the field structure.
+- `insert?` allows the creation of the field and any missing intermediate
+ fields.
+- `strict?` causes an error to be thrown if the exact field-path is not found
+ in the data"
+  (lambda (package)
+    (fold
+      (lambda (field package)
+        (let*
+          (
+            (field-path (field-path-mapper field))
+            (
+              field-path
+              (cond
+                ((string? field-path)
+                  (string-split field-path #\.))
+                ((and (list? field-path) (every string? field-path))
+                  field-path)
+                (else
+                  (error
+                    (string-append
+                      "Invalid field value provided, expecting a string or a "
+                      "list of string but instead got: "
+                      (with-output-to-string (lambda _ (display field-path))))))
+              )))
+          (let loop
+            (
+              (data package)
+              (field-path field-path))
+            (let*
+              (
+                (key (car field-path))
+                (data
+                  (if (and (not (assoc key data)) insert?)
+                    (acons key '() data)
+                    data)))
+              (if (not (assoc key data))
+                (if strict?
+                  (error (string-append
+                    "Key '" key "' was not found in data: "
+                    (with-output-to-string (lambda _ (display data)))))
+                  data)
+                (if (= (length field-path) 1)
+                  (field-modifier field data key)
+                  (assoc-set!
+                    data
+                    key
+                    (loop (assoc-ref data key) (cdr field-path)))))))))
+      package
+      fields)))
+
+(define* (delete-fields fields #:key (strict? #t))
+  "Provides a lambda to supply to modify-json which deletes the specified
+ `fields` which is a list of field-paths as mentioned in `modify-json-fields`.
+ Examples:
+  (delete-fields '(
+    (\"path\" \"to\" \"field\")
+    \"path.to.other.field\"))"
+  (modify-json-fields
+    fields
+    (lambda (_ data key)
+      (assoc-remove! data key))
+    #:strict? strict?))
+
+(define* (replace-fields fields #:key (strict? #t))
+  "Provides a lambda to supply to modify-json which replaces the value of the
+ supplied field. `fields` is a list of pairs, where the first element is the
+ field-path and the second element is the value to replace the target with.
+ Examples:
+  (replace-fields '(
+    ((\"path\" \"to\" \"field\") \"new field value\")
+    (\"path.to.other.field\" \"new field value\")))"
+  (modify-json-fields
+    fields
+    (lambda (field data key)
+      (assoc-set! data key (cdr field)))
+    #:field-path-mapper (lambda (field) (car field))
+    #:strict? strict?))
+
+(define (delete-dev-dependencies)
+  (delete-fields (list "devDependencies") #:strict #f))
+
 ;;;
 ;;; Phases.
 ;;;
@@ -144,31 +295,6 @@ (define (resolve-dependencies dependencies)
                   (assoc-ref* pkg-meta "dependencies" '())))))))))
   #t)
 
-(define (delete-dependencies dependencies-to-remove)
-  "Rewrite 'package.json' to allow the build to proceed without packages
-listed in 'dependencies-to-remove', a list of strings naming npm packages.
-
-To prevent the deleted dependencies from being reintroduced, use this function
-only after the 'patch-dependencies' phase."
-  (with-atomic-json-file-replacement
-    (lambda (pkg-meta)
-      (fold
-        (lambda (dependency-key pkg-meta)
-          (alist-update
-            pkg-meta
-            dependency-key
-            (lambda (dependencies)
-              (remove
-                (lambda (dependency)
-                  (member (car dependency) dependencies-to-remove))
-                dependencies))))
-        pkg-meta
-        (list
-          "devDependencies"
-          "dependencies"
-          "peerDependencies"
-          "optionalDependencies")))))
-
 (define* (delete-lockfiles #:key inputs #:allow-other-keys)
   "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
 exist."
-- 
2.48.1





Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:03 GMT) Full text and rfc822 format available.

Message #44 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: Nicolas Graves <ngraves <at> ngraves.fr>, jlicht <at> fsfe.org,
 d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 3/6] build-system/node: Add guile-json extension.
Date: Tue, 18 Feb 2025 00:43:54 +0100
* guix/build-system/node.scm (default-guile-json): New variable.
(node-build): Use guile-json extension.
---
 guix/build-system/node.scm | 39 ++++++++++++++++++++++----------------
 1 file changed, 23 insertions(+), 16 deletions(-)

diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 425b8cd9b3..240336ea35 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -80,6 +80,12 @@ (define private-keywords
          (build node-build)
          (arguments (strip-keyword-arguments private-keywords arguments)))))
 
+(define (default-guile-json)
+  "Return the default guile-json package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((mod (resolve-interface '(gnu packages guile))))
+    (module-ref mod 'guile-json-4)))
+
 (define* (node-build name inputs
                      #:key
                      source
@@ -90,27 +96,28 @@ (define* (node-build name inputs
                      (outputs '("out"))
                      (search-paths '())
                      (system (%current-system))
-                     (guile #f)
+                     (guile-json (default-guile-json))
                      (imported-modules %node-build-system-modules)
                      (modules '((guix build node-build-system)
                                 (guix build utils))))
   "Build SOURCE using NODE and INPUTS."
   (define builder
-    (with-imported-modules imported-modules
-      #~(begin
-          (use-modules #$@(sexp->gexp modules))
-          (node-build #:name #$name
-                      #:source #+source
-                      #:system #$system
-                      #:npm-flags #$npm-flags
-                      #:test-target #$test-target
-                      #:tests? #$tests?
-                      #:phases #$phases
-                      #:outputs #$(outputs->gexp outputs)
-                      #:search-paths '#$(sexp->gexp
-                                         (map search-path-specification->sexp
-                                              search-paths))
-                      #:inputs #$(input-tuples->gexp inputs)))))
+    (with-extensions (list guile-json)
+      (with-imported-modules imported-modules
+        #~(begin
+            (use-modules #$@(sexp->gexp modules))
+            (node-build #:name #$name
+                        #:source #+source
+                        #:system #$system
+                        #:npm-flags #$npm-flags
+                        #:test-target #$test-target
+                        #:tests? #$tests?
+                        #:phases #$phases
+                        #:outputs #$(outputs->gexp outputs)
+                        #:search-paths '#$(sexp->gexp
+                                           (map search-path-specification->sexp
+                                                search-paths))
+                        #:inputs #$(input-tuples->gexp inputs))))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
-- 
2.48.1





Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:03 GMT) Full text and rfc822 format available.

Message #47 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: Nicolas Graves <ngraves <at> ngraves.fr>, jlicht <at> fsfe.org,
 d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 4/6] build-system/node: Use test-target argument.
Date: Tue, 18 Feb 2025 00:43:55 +0100
* guix/build/node-build-system.scm (check): Use test-target argument.
---
 guix/build/node-build-system.scm | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index ea23d92a05..9967069458 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -319,13 +319,12 @@ (define* (build #:key inputs #:allow-other-keys)
         (format #t "there is no build script to run~%"))
     #t))
 
-(define* (check #:key tests? inputs #:allow-other-keys)
-  "Run 'npm test' if TESTS?"
+(define* (check #:key tests? inputs test-target #:allow-other-keys)
+  "Run 'npm run TEST-TARGET' if TESTS?"
   (if tests?
       (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
-        (invoke npm "test"))
-      (format #t "test suite not run~%"))
-  #t)
+        (invoke npm "run" test-target))
+      (format #t "test suite not run~%")))
 
 (define* (repack #:key inputs #:allow-other-keys)
   (invoke "tar"
-- 
2.48.1





Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:04 GMT) Full text and rfc822 format available.

Message #50 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: Nicolas Graves <ngraves <at> ngraves.fr>, jlicht <at> fsfe.org,
 d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 0/6] build-system/node: Replace (guix build json) by (json).
Date: Tue, 18 Feb 2025 00:43:51 +0100
This is a rework of Daniel's patch series.

I have reworded commit messages to respect (info) Standards ; did some
reindenting ; added the guile-json extension as suggested by Ludo ;
added a patch to use the test-target argument ; and did the same for
tree-sitter modules (which was necessary).

Daniel Khodabakhsh (2):
  build-system/node: Switch to (json).
  build-system/node: New API for modifying json.

Nicolas Graves (4):
  build-system/node: Add guile-json extension.
  build-system/node: Use test-target argument.
  build-system/tree-sitter: Switch to (json).
  build-system/tree-sitter: Add guile-json extension.

 gnu/packages/node-xyz.scm               | 449 +++++++++++-------------
 gnu/packages/node.scm                   |  86 ++---
 guix/build-system/node.scm              |  45 ++-
 guix/build-system/tree-sitter.scm       | 101 +++---
 guix/build/node-build-system.scm        | 337 +++++++++++-------
 guix/build/tree-sitter-build-system.scm |  44 ++-
 6 files changed, 561 insertions(+), 501 deletions(-)

-- 
2.48.1





Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:05 GMT) Full text and rfc822 format available.

Message #53 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: Nicolas Graves <ngraves <at> ngraves.fr>, jlicht <at> fsfe.org,
 d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 5/6] build-system/tree-sitter: Switch to (json).
Date: Tue, 18 Feb 2025 00:43:56 +0100
* guix/build/tree-sitter-build-system.scm (patch-dependencies,
install): Switch from (guix build json) to (json).
---
 guix/build/tree-sitter-build-system.scm | 44 +++++++++++--------------
 1 file changed, 20 insertions(+), 24 deletions(-)

diff --git a/guix/build/tree-sitter-build-system.scm b/guix/build/tree-sitter-build-system.scm
index 4106728bdf..1fe2601dd7 100644
--- a/guix/build/tree-sitter-build-system.scm
+++ b/guix/build/tree-sitter-build-system.scm
@@ -18,10 +18,10 @@
 
 (define-module (guix build tree-sitter-build-system)
   #:use-module ((guix build node-build-system) #:prefix node:)
-  #:use-module (guix build json)
   #:use-module (guix build utils)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:export (%standard-phases
             tree-sitter-build))
@@ -47,28 +47,24 @@ (define* (patch-dependencies #:key inputs #:allow-other-keys)
   "Rewrite dependencies in 'package.json'.  We remove all runtime dependencies
 and replace development dependencies with tree-sitter grammar node modules."
 
-  (define (rewrite package.json)
-    (map (match-lambda
-           (("dependencies" @ . _)
-            '("dependencies" @))
-           (("devDependencies" @ . _)
-            `("devDependencies" @
-              ,@(filter-map (match-lambda
-                              ((key . directory)
-                               (let ((node-module
-                                      (string-append directory
-                                                     "/lib/node_modules/"
-                                                     key)))
-                                 (and (directory-exists? node-module)
-                                      `(,key . ,node-module)))))
-                            (alist-delete "node" inputs))))
-           (other other))
-         package.json))
-
-  (node:with-atomic-json-file-replacement "package.json"
-    (match-lambda
-      (('@ . package.json)
-       (cons '@ (rewrite package.json))))))
+  (node:with-atomic-json-file-replacement
+   (lambda (pkg-meta-alist)
+     (map (match-lambda
+            (("dependencies" dependencies ...)
+             '("dependencies"))
+            (("devDependencies" dev-dependencies ...)
+             `("devDependencies"
+               ,@(filter-map (match-lambda
+                               ((key . directory)
+                                (let ((node-module
+                                       (string-append directory
+                                                      "/lib/node_modules/"
+                                                      key)))
+                                  (and (directory-exists? node-module)
+                                       `(,key . ,node-module)))))
+                             (alist-delete "node" inputs))))
+            (other other))
+          pkg-meta-alist))))
 
 ;; FIXME: The node build-system's configure phase does not support
 ;; cross-compiling so we re-define it.
@@ -99,7 +95,7 @@ (define* (install #:key target grammar-directories outputs #:allow-other-keys)
     (define (compile-language dir)
       (with-directory-excursion dir
         (let ((lang (assoc-ref (call-with-input-file "src/grammar.json"
-                                 read-json)
+                                 json->scm)
                                "name"))
               (source-file (lambda (path)
                              (if (file-exists? path)
-- 
2.48.1





Information forwarded to guix-patches <at> gnu.org:
bug#74900; Package guix-patches. (Mon, 17 Feb 2025 23:49:05 GMT) Full text and rfc822 format available.

Message #56 received at 74900 <at> debbugs.gnu.org (full text, mbox):

From: Nicolas Graves <ngraves <at> ngraves.fr>
To: 74900 <at> debbugs.gnu.org
Cc: Nicolas Graves <ngraves <at> ngraves.fr>, jlicht <at> fsfe.org,
 d.khodabakhsh <at> gmail.com
Subject: [PATCH v2 6/6] build-system/tree-sitter: Add guile-json extension.
Date: Tue, 18 Feb 2025 00:43:57 +0100
* guix/build-system/tree-sitter.scm (default-guile-json): New variable.
(tree-sitter-cross-build, tree-sitter-build): Use guile-json extension.
---
 guix/build-system/tree-sitter.scm | 101 ++++++++++++++++--------------
 1 file changed, 55 insertions(+), 46 deletions(-)

diff --git a/guix/build-system/tree-sitter.scm b/guix/build-system/tree-sitter.scm
index 21c4eb35b2..f59a255307 100644
--- a/guix/build-system/tree-sitter.scm
+++ b/guix/build-system/tree-sitter.scm
@@ -36,6 +36,12 @@ (define %tree-sitter-build-system-modules
   `((guix build tree-sitter-build-system)
     ,@%node-build-system-modules))
 
+(define (default-guile-json)
+  "Return the default guile-json package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((mod (resolve-interface '(gnu packages guile))))
+    (module-ref mod 'guile-json-4)))
+
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 #:allow-other-keys
@@ -98,26 +104,27 @@ (define* (tree-sitter-build name inputs
                             (outputs '("out" "js"))
                             (search-paths '())
                             (system (%current-system))
-                            (guile #f)
+                            (guile-json (default-guile-json))
                             (imported-modules %tree-sitter-build-system-modules)
                             (modules '((guix build utils)
                                        (guix build tree-sitter-build-system))))
   (define builder
-    (with-imported-modules imported-modules
-      #~(begin
-          (use-modules #$@(sexp->gexp modules))
-          (tree-sitter-build #:name #$name
-                             #:source #+source
-                             #:system #$system
-                             #:phases #$phases
-                             #:tests? #$tests?
-                             #:grammar-directories '#$grammar-directories
-                             #:outputs #$(outputs->gexp outputs)
-                             #:search-paths
-                             '#$(sexp->gexp
-                                 (map search-path-specification->sexp
-                                      search-paths))
-                             #:inputs #$(input-tuples->gexp inputs)))))
+    (with-extensions (list guile-json)
+      (with-imported-modules imported-modules
+        #~(begin
+            (use-modules #$@(sexp->gexp modules))
+            (tree-sitter-build #:name #$name
+                               #:source #+source
+                               #:system #$system
+                               #:phases #$phases
+                               #:tests? #$tests?
+                               #:grammar-directories '#$grammar-directories
+                               #:outputs #$(outputs->gexp outputs)
+                               #:search-paths
+                               '#$(sexp->gexp
+                                   (map search-path-specification->sexp
+                                        search-paths))
+                               #:inputs #$(input-tuples->gexp inputs))))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
@@ -137,6 +144,7 @@ (define* (tree-sitter-cross-build name
                                   (search-paths '())
                                   (native-search-paths '())
                                   (system (%current-system))
+                                  (guile-json (default-guile-json))
                                   (build (nix-system->gnu-triplet system))
                                   (imported-modules
                                    %tree-sitter-build-system-modules)
@@ -144,40 +152,41 @@ (define* (tree-sitter-cross-build name
                                    '((guix build utils)
                                      (guix build tree-sitter-build-system))))
   (define builder
-    (with-imported-modules imported-modules
-      #~(begin
-          (use-modules #$@(sexp->gexp modules))
+    (with-extensions (list guile-json)
+      (with-imported-modules imported-modules
+        #~(begin
+            (use-modules #$@(sexp->gexp modules))
 
-          (define %build-host-inputs
-            #+(input-tuples->gexp build-inputs))
+            (define %build-host-inputs
+              #+(input-tuples->gexp build-inputs))
 
-          (define %build-target-inputs
-            (append #$(input-tuples->gexp host-inputs)
-                    #+(input-tuples->gexp target-inputs)))
+            (define %build-target-inputs
+              (append #$(input-tuples->gexp host-inputs)
+                      #+(input-tuples->gexp target-inputs)))
 
-          (define %build-inputs
-            (append %build-host-inputs %build-target-inputs))
+            (define %build-inputs
+              (append %build-host-inputs %build-target-inputs))
 
-          (tree-sitter-build #:name #$name
-                             #:source #+source
-                             #:system #$system
-                             #:build #$build
-                             #:target #$target
-                             #:phases #$phases
-                             #:tests? #$tests?
-                             #:grammar-directories '#$grammar-directories
-                             #:outputs #$(outputs->gexp outputs)
-                             #:inputs %build-target-inputs
-                             #:native-inputs %build-host-inputs
-                             #:search-paths '
-                             #$(sexp->gexp
-                                (map search-path-specification->sexp
-                                     search-paths))
-                             #:native-search-paths
-                             '#$(sexp->gexp
-                                 (map
-                                  search-path-specification->sexp
-                                  native-search-paths))))))
+            (tree-sitter-build #:name #$name
+                               #:source #+source
+                               #:system #$system
+                               #:build #$build
+                               #:target #$target
+                               #:phases #$phases
+                               #:tests? #$tests?
+                               #:grammar-directories '#$grammar-directories
+                               #:outputs #$(outputs->gexp outputs)
+                               #:inputs %build-target-inputs
+                               #:native-inputs %build-host-inputs
+                               #:search-paths '
+                               #$(sexp->gexp
+                                  (map search-path-specification->sexp
+                                       search-paths))
+                               #:native-search-paths
+                               '#$(sexp->gexp
+                                   (map
+                                    search-path-specification->sexp
+                                    native-search-paths)))))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
-- 
2.48.1





Reply sent to Jelle Licht <jlicht <at> fsfe.org>:
You have taken responsibility. (Tue, 18 Feb 2025 10:51:02 GMT) Full text and rfc822 format available.

Notification sent to Daniel Khodabakhsh <d.khodabakhsh <at> gmail.com>:
bug acknowledged by developer. (Tue, 18 Feb 2025 10:51:02 GMT) Full text and rfc822 format available.

Message #61 received at 74900-done <at> debbugs.gnu.org (full text, mbox):

From: Jelle Licht <jlicht <at> fsfe.org>
To: Nicolas Graves <ngraves <at> ngraves.fr>, 74900-done <at> debbugs.gnu.org
Cc: d.khodabakhsh <at> gmail.com
Subject: Re: [PATCH v2 0/6] build-system/node: Replace (guix build json) by
 (json).
Date: Tue, 18 Feb 2025 11:50:14 +0100
Hey folks,

Nicolas Graves <ngraves <at> ngraves.fr> writes:

> This is a rework of Daniel's patch series.
>
> I have reworded commit messages to respect (info) Standards ; did some
> reindenting ; added the guile-json extension as suggested by Ludo ;
> added a patch to use the test-target argument ; and did the same for
> tree-sitter modules (which was necessary).
>
> Daniel Khodabakhsh (2):
>   build-system/node: Switch to (json).
>   build-system/node: New API for modifying json.
>
> Nicolas Graves (4):
>   build-system/node: Add guile-json extension.
>   build-system/node: Use test-target argument.
>   build-system/tree-sitter: Switch to (json).
>   build-system/tree-sitter: Add guile-json extension.

Applied + pushed to a new javascript-team branch with the following
small changes to get it to compile cleanly:

diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 240336ea35..cde0ccb60e 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -96,6 +96,7 @@ (define* (node-build name inputs
                      (outputs '("out"))
                      (search-paths '())
                      (system (%current-system))
+                     (guile #f)
                      (guile-json (default-guile-json))
                      (imported-modules %node-build-system-modules)
                      (modules '((guix build node-build-system)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 9967069458..05940bc997 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -221,7 +221,7 @@ (define* (replace-fields fields #:key (strict? #t))
     #:strict? strict?))
 
 (define (delete-dev-dependencies)
-  (delete-fields (list "devDependencies") #:strict #f))
+  (delete-fields (list "devDependencies") #:strict? #f))
 
 ;;;
 ;;; Phases.
diff --git a/guix/build-system/tree-sitter.scm b/guix/build-system/tree-sitter.scm
index f59a255307..90d9704cb8 100644
--- a/guix/build-system/tree-sitter.scm
+++ b/guix/build-system/tree-sitter.scm
@@ -104,6 +104,7 @@ (define* (tree-sitter-build name inputs
                             (outputs '("out" "js"))
                             (search-paths '())
                             (system (%current-system))
+                            (guile #f)
                             (guile-json (default-guile-json))
                             (imported-modules %tree-sitter-build-system-modules)
                             (modules '((guix build utils)




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Tue, 18 Mar 2025 11:24:14 GMT) Full text and rfc822 format available.

This bug report was last modified 94 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.