amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system/node: Switch to (json).

Browse source 
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.

Change-Id: I9fd5152a98b6a241d414e9a94ab179c9cabcfb85
Signed-off-by: Jelle Licht <jlicht@fsfe.org>
This commit is contained in:
Daniel Khodabakhsh 2025-02-18 00:43:52 +01:00 • committed by Andreas Enge
parent a33e152f2e
commit 86caf257e7
No known key found for this signature in database
GPG key ID: F7D5C9BF765C61E3
3 changed files with 139 additions and 195 deletions
Download patch file Download diff file Expand all files Collapse all files

104
gnu/packages/node-xyz.scm
View file

@ -7,6 +7,7 @@
;;; Copyright © 2021 Dhruvin Gandhi <contact@dhruvin.dev> ;;; Copyright © 2021 Dhruvin Gandhi <contact@dhruvin.dev>
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr> ;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2023 Jelle Licht <jlicht@fsfe.org> ;;; Copyright © 2023 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -24,14 +25,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages node-xyz) (define-module (gnu packages node-xyz)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages sqlite) #:use-module (gnu packages sqlite)
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (guix build-system node)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix git-download) #: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. ;;; Please: Try to add new module packages in alphabetic order.
@ -69,19 +70,17 @@
;; it would try to use the build environment and would block the ;; it would try to use the build environment and would block the
;; automatic building by other packages making use of node-acorn. ;; automatic building by other packages making use of node-acorn.
;; TODO: Add utility function ;; TODO: Add utility function
(with-atomic-json-file-replacement "package.json" (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
(map
(match-lambda (match-lambda
(('@ . pkg-meta-alist) (("scripts" . scripts-alist)
(cons '@ (map (match-lambda (cons "scripts" (filter
(("scripts" @ . scripts-alist) (match-lambda
`("scripts" @ ,@(filter (match-lambda (("prepare" . _) #f)
(("prepare" . _) (_ #t))
#f)
(_
#t))
scripts-alist))) scripts-alist)))
(other other)) (other other))
pkg-meta-alist))))))) pkg-meta-alist)))))
(replace 'build (replace 'build
(lambda* (#:key inputs native-inputs #:allow-other-keys) (lambda* (#:key inputs native-inputs #:allow-other-keys)
(let ((esbuild (search-input-file (or native-inputs inputs) (let ((esbuild (search-input-file (or native-inputs inputs)
@ -158,23 +157,17 @@ architecture supporting plugins.")
(lambda args (lambda args
(define new-test-script (define new-test-script
"echo stopping after pretest on Guix") "echo stopping after pretest on Guix")
(with-atomic-json-file-replacement "package.json" (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
(map
(match-lambda (match-lambda
(('@ . pkg-meta-alist) (("scripts" . scripts-alist)
(cons (cons "scripts" (map
'@ (match-lambda
(map (match-lambda (("test" . _) (cons "test" new-test-script))
(("scripts" '@ . scripts-alist) (other other))
`("scripts" @ ,@(map (match-lambda
(("test" . _)
(cons "test"
new-test-script))
(other
other))
scripts-alist))) scripts-alist)))
(other (other other))
other)) pkg-meta-alist))))))))
pkg-meta-alist))))))))))
(home-page "https://github.com/nodejs/node-addon-api") (home-page "https://github.com/nodejs/node-addon-api")
(synopsis "Node.js API (Node-API) header-only C++ wrappers") (synopsis "Node.js API (Node-API) header-only C++ wrappers")
(description "This module contains header-only C++ wrapper classes which (description "This module contains header-only C++ wrapper classes which
@ -1223,22 +1216,19 @@ it to make a new binding for a different platform or underling technology.")))
"node-abi")))) "node-abi"))))
(add-after 'chdir 'avoid-prebuild-install (add-after 'chdir 'avoid-prebuild-install
(lambda args (lambda args
(with-atomic-json-file-replacement "package.json" (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
(map
(match-lambda (match-lambda
(('@ . pkg-meta-alist) (("scripts" . scripts-alist)
(cons '@ (map (match-lambda (cons "scripts" (filter
(("scripts" @ . scripts-alist) (match-lambda
`("scripts" @ ,@(filter (match-lambda (("install" . _) #f)
(("install" . _) (_ #t))
#f)
(_
#t))
scripts-alist))) scripts-alist)))
(("gypfile" . _) (("gypfile" . _)
'("gypfile" . #f)) (cons "gypfile" #f))
(other (other other))
other)) pkg-meta-alist))))))
pkg-meta-alist))))))))
#:tests? #f)) #:tests? #f))
(synopsis "Abstract base class for Node SerialPort bindings") (synopsis "Abstract base class for Node SerialPort bindings")
(description "Node SerialPort is a modular suite of Node.js packages for (description "Node SerialPort is a modular suite of Node.js packages for
@ -1524,11 +1514,8 @@ connection.")))
(substitute* ".npmignore" (substitute* ".npmignore"
(("lib/binding") (("lib/binding")
"#lib/binding # <- patched for Guix")) "#lib/binding # <- patched for Guix"))
(with-atomic-json-file-replacement "package.json" (with-atomic-json-file-replacement (lambda (pkg-meta-alist)
(match-lambda (let ((binary-alist (assoc-ref pkg-meta-alist "binary")))
(('@ . pkg-meta-alist)
(match (assoc-ref pkg-meta-alist "binary")
(('@ . binary-alist)
;; When it builds from source, node-pre-gyp supplies ;; When it builds from source, node-pre-gyp supplies
;; module_name and module_path based on the entries under ;; module_name and module_path based on the entries under
;; "binary" from "package.json", so this package's ;; "binary" from "package.json", so this package's
@ -1536,27 +1523,24 @@ connection.")))
;; to supply them. The GYP_DEFINES environment variable ;; to supply them. The GYP_DEFINES environment variable
;; turns out to be the easiest way to make sure they are ;; turns out to be the easiest way to make sure they are
;; propagated from npm to node-gyp to gyp. ;; propagated from npm to node-gyp to gyp.
(setenv "GYP_DEFINES" (setenv "GYP_DEFINES" (string-append
(string-append
"module_name=" "module_name="
(assoc-ref binary-alist "module_name") (assoc-ref binary-alist "module_name")
" "
" module_path=" " module_path="
(assoc-ref binary-alist "module_path"))))) (assoc-ref binary-alist "module_path"))))
;; We need to remove the install script from "package.json", ;; We need to remove the install script from "package.json",
;; as it would try to use node-pre-gyp and would block the ;; as it would try to use node-pre-gyp and would block the
;; automatic building performed by `npm install`. ;; automatic building performed by `npm install`.
(cons '@ (map (match-lambda (map
(("scripts" @ . scripts-alist) (match-lambda
`("scripts" @ ,@(filter (match-lambda (("scripts" . scripts-alist)
(("install" . _) (cons "scripts" (filter
#f) (match-lambda
(_ (("install" . _) #f)
#t)) (_ #t))
scripts-alist))) scripts-alist)))
(other (other other))
other)) pkg-meta-alist))))))))
pkg-meta-alist))))))))))
(home-page "https://github.com/mapbox/node-sqlite3") (home-page "https://github.com/mapbox/node-sqlite3")
(synopsis "Node.js bindings for SQLite3") (synopsis "Node.js bindings for SQLite3")
(description (description

6
guix/build-system/node.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2021 Philip McGrath <philip@philipmcgrath.com> ;;; Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
;;; Copyright © 2024 Daniel Khodabakhsh <d.khodabakhsh@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,7 +37,10 @@
(define %node-build-system-modules (define %node-build-system-modules
;; Build-side modules imported by default. ;; Build-side modules imported by default.
`((guix build node-build-system) `((guix build node-build-system)
(guix build json) (json)
(json builder)
(json parser)
(json record)
,@%default-gnu-imported-modules)) ,@%default-gnu-imported-modules))
(define (default-node) (define (default-node)

162
guix/build/node-build-system.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2019, 2021 Timothy Sample <samplet@ngyro.com> ;;; Copyright © 2019, 2021 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2021, 2022 Philip McGrath <philip@philipmcgrath.com> ;;; Copyright © 2021, 2022 Philip McGrath <philip@philipmcgrath.com>
;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler@gmail.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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -23,10 +24,10 @@
(define-module (guix build node-build-system) (define-module (guix build node-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix build json)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (json)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-71) #:use-module (srfi srfi-71)
#:export (%standard-phases #:export (%standard-phases
@ -34,13 +35,14 @@
delete-dependencies delete-dependencies
node-build)) 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 "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 argument---the result of parsing FILE's contents as json---and should a value
to be written as json to the replacement FILE." to be written as json to the replacement FILE."
(with-atomic-file-replacement file (with-atomic-file-replacement file
(lambda (in out) (lambda (in out)
(write-json (proc (read-json in)) out)))) (scm->json (proc (json->scm in)) out))))
(define* (assoc-ref* alist key #:optional default) (define* (assoc-ref* alist key #:optional default)
"Like assoc-ref, but return DEFAULT instead of #f if no value exists." "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
@ -48,10 +50,6 @@ to be written as json to the replacement FILE."
(#f default) (#f default)
((_ . value) value))) ((_ . value) value)))
(define* (jsobject-ref obj key #:optional default)
(match obj
(('@ . alist) (assoc-ref* alist key default))))
(define* (alist-pop alist key #:optional (= equal?)) (define* (alist-pop alist key #:optional (= equal?))
"Return two values, the first pair in ALIST with key KEY, and the other "Return two values, the first pair in ALIST with key KEY, and the other
elements. Equality calls are made as (= KEY ALISTCAR)." elements. Equality calls are made as (= KEY ALISTCAR)."
@ -63,67 +61,17 @@ elements. Equality calls are made as (= KEY ALISTCAR)."
(values (car after) (append before (cdr after))) (values (car after) (append before (cdr after)))
(values #f before)))) (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 "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). 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 Unlike acons, this removes the previous association of KEY (assuming it is
unique), but the result may still share storage with ALIST." unique), but the result may still share storage with ALIST."
(let ((pair rest (alist-pop alist key =))) (let ((pair rest (alist-pop alist key =)))
(acons key (if (pair? pair)
(proc (if (pair? pair) (acons key (proc (cdr pair)) rest)
(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))) 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. ;;; Phases.
;;; ;;;
@ -142,8 +90,8 @@ found in one of the OBJECTS."
(define (module-name module) (define (module-name module)
(let* ((package.json (string-append module "/package.json")) (let* ((package.json (string-append module "/package.json"))
(package-meta (call-with-input-file package.json read-json))) (package-meta (call-with-input-file package.json json->scm)))
(jsobject-ref package-meta "name"))) (assoc-ref package-meta "name")))
(define (index-modules input-paths) (define (index-modules input-paths)
(define (list-modules directory) (define (list-modules directory)
@ -167,49 +115,59 @@ found in one of the OBJECTS."
(define index (index-modules (map cdr inputs))) (define index (index-modules (map cdr inputs)))
(define resolve-dependencies (define (resolve-dependencies dependencies)
(map
(match-lambda (match-lambda
(('@ . alist) ((dependency . version)
(cons '@ (map (match-lambda (cons dependency (hash-ref index dependency version))))
((key . value) dependencies))
(cons key (hash-ref index key value))))
alist)))))
(with-atomic-json-file-replacement "package.json" (with-atomic-json-file-replacement
(lambda (pkg-meta) (lambda (pkg-meta)
(jsobject-update* (fold
(lambda (proc pkg-meta) (proc pkg-meta))
pkg-meta pkg-meta
`("devDependencies" ,resolve-dependencies (@)) (list
`("dependencies" ,(lambda (deps) (lambda (pkg-meta)
(alist-update pkg-meta "devDependencies" resolve-dependencies))
(lambda (pkg-meta)
(assoc-set!
pkg-meta
"dependencies"
(resolve-dependencies (resolve-dependencies
(jsobject-union ; Combined "peerDependencies" and "dependencies" dependencies
(lambda (k a b) b) ; with "dependencies" taking precedent.
(jsobject-ref pkg-meta "peerDependencies" '(@)) (fold
deps))) (lambda (dependency dependencies)
(@))))) (assoc-set! dependencies (car dependency) (cdr dependency)))
(assoc-ref* pkg-meta "peerDependencies" '())
(assoc-ref* pkg-meta "dependencies" '())))))))))
#t) #t)
(define (delete-dependencies absent) (define (delete-dependencies dependencies-to-remove)
"Rewrite 'package.json' to allow the build to proceed without packages "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 To prevent the deleted dependencies from being reintroduced, use this function
only after the 'patch-dependencies' phase." only after the 'patch-dependencies' phase."
(define delete-from-jsobject (with-atomic-json-file-replacement
(match-lambda
(('@ . alist)
(cons '@ (filter (match-lambda
((k . _)
(not (member k absent))))
alist)))))
(with-atomic-json-file-replacement "package.json"
(lambda (pkg-meta) (lambda (pkg-meta)
(jsobject-update* (fold
(lambda (dependency-key pkg-meta)
(alist-update
pkg-meta pkg-meta
`("devDependencies" ,delete-from-jsobject (@)) dependency-key
`("dependencies" ,delete-from-jsobject (@)) (lambda (dependencies)
`("peerDependencies" ,delete-from-jsobject (@)))))) (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) (define* (delete-lockfiles #:key inputs #:allow-other-keys)
"Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they
@ -228,8 +186,8 @@ exist."
#t)) #t))
(define* (build #:key inputs #:allow-other-keys) (define* (build #:key inputs #:allow-other-keys)
(let ((package-meta (call-with-input-file "package.json" read-json))) (let ((package-meta (call-with-input-file "package.json" json->scm)))
(if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f) (if (assoc-ref* (assoc-ref* package-meta "scripts" '()) "build" #f)
(let ((npm (string-append (assoc-ref inputs "node") "/bin/npm"))) (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
(invoke npm "run" "build")) (invoke npm "run" "build"))
(format #t "there is no build script to run~%")) (format #t "there is no build script to run~%"))
@ -301,19 +259,17 @@ would try to run 'node-gyp rebuild'."
;; even need to overwrite this file. Therefore, let's use some helpers ;; even need to overwrite this file. Therefore, let's use some helpers
;; that we'd otherwise not need. ;; that we'd otherwise not need.
(define pkg-meta (define pkg-meta
(call-with-input-file installed-package.json read-json)) (call-with-input-file installed-package.json json->scm))
(define scripts (define scripts
(jsobject-ref pkg-meta "scripts" '(@))) (assoc-ref* pkg-meta "scripts" '()))
(define (jsobject-set js key val)
(jsobject-update* js (list key (const val))))
(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 (call-with-output-file installed-package.json
(lambda (out) (lambda (out)
(write-json (scm->json
(jsobject-set pkg-meta (assoc-set! pkg-meta
"scripts" "scripts"
(jsobject-set scripts (assoc-set! scripts
"install" "install"
"echo Guix: avoiding node-gyp rebuild")) "echo Guix: avoiding node-gyp rebuild"))
out))))) out)))))