From: Daniel Khodabakhsh <d.khodabakhsh@gmail.com>
To: 74900@debbugs.gnu.org
Subject: [bug#74900] [PATCH] Replace (guix build json) with (json) in node build system
Date: Sun, 15 Dec 2024 20:30:16 +0000 [thread overview]
Message-ID: <CAADuFnKAGHb2=rTFiwD9yXN3=OKbZdragGaCJJ0BkOhofDb2KQ@mail.gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 23342 bytes --]
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@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@dhruvin.dev>
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2023 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@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@gnu.org>
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@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@ngyro.com>
;;; Copyright © 2021, 2022 Philip McGrath <philip@philipmcgrath.com>
;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@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
[-- Attachment #2: 0001-Replace-guix-build-json-with-json-in-node-build-syst.patch --]
[-- Type: text/x-patch, Size: 22925 bytes --]
From 0095c2cf7e9766bc4740441c849219a306023522 Mon Sep 17 00:00:00 2001
From: Daniel Khodabakhsh <d.khodabakhsh@gmail.com>
Date: Sun, 15 Dec 2024 11:30:33 -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@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@dhruvin.dev>
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2023 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@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@gnu.org>
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@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@ngyro.com>
;;; Copyright © 2021, 2022 Philip McGrath <philip@philipmcgrath.com>
;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@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)))
-
-\f
;;;
;;; 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
next reply other threads:[~2024-12-15 20:31 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-12-15 20:30 Daniel Khodabakhsh [this message]
2024-12-15 21:41 ` [bug#74900] Daniel Khodabakhsh
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAADuFnKAGHb2=rTFiwD9yXN3=OKbZdragGaCJJ0BkOhofDb2KQ@mail.gmail.com' \
--to=d.khodabakhsh@gmail.com \
--cc=74900@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).