guix_mirror_bot pushed a commit to branch javascript-team in repository guix.
commit 81f53b9672dcfe17f9c1f29d1ac60daf689b9b1f Author: Nicolas Graves <[email protected]> AuthorDate: Wed Mar 18 07:55:37 2026 +0100 guix: Refactor (guix build json-utils) from the node build system. * guix/build/node-build-system.scm (delete-fields, modify-json, modify-json-fields, replace-fields) (with-atomic-json-file-replacement, add-fields): Move procedures from here... * guix/build/json-utils.scm: ...to this new file. * guix/build-system/node.scm (%node-build-system-modules, node-build): Add (guix build json-utils) module. * guix/build/tree-sitter-build-system.scm (patch-dependencies): Import with-atomic-json-file-replacement from (guix build json-utils). * guix/import/npm-binary.scm: Import (guix build json-utils). * CODEOWNERS, etc/teams.scm: Add guix/build/json-utils.scm to the javascript team scope. * Makefile.am: Add guix/build/json-utils.scm. Change-Id: I5264a5265e376902c0a309c0177b7496ac3b6295 Signed-off-by: Jelle Licht <[email protected]> --- CODEOWNERS | 1 + Makefile.am | 1 + etc/teams.scm | 1 + guix/build-system/node.scm | 2 + guix/build/json-utils.scm | 164 ++++++++++++++++++++++++++++++++ guix/build/node-build-system.scm | 127 +------------------------ guix/build/tree-sitter-build-system.scm | 3 +- guix/import/npm-binary.scm | 1 + 8 files changed, 175 insertions(+), 125 deletions(-) diff --git a/CODEOWNERS b/CODEOWNERS index efe7828137..774f0c3b89 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -283,6 +283,7 @@ gnu/packages/javascript\.scm @guix/javascript gnu/packages/node-xyz\.scm @guix/javascript gnu/packages/node\.scm @guix/javascript guix/build-system/node\.scm @guix/javascript +guix/build/json-utils\.scm @guix/javascript guix/build/node-build-system\.scm @guix/javascript guix/import/npm-binary\.scm @guix/javascript guix/scripts/import/npm-binary\.scm @guix/javascript diff --git a/Makefile.am b/Makefile.am index 8780df9637..e59d07d284 100644 --- a/Makefile.am +++ b/Makefile.am @@ -266,6 +266,7 @@ MODULES = \ guix/build/vim-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ + guix/build/json-utils.scm \ guix/build/julia-build-system.scm \ guix/build/kconfig.scm \ guix/build/linux-module-build-system.scm \ diff --git a/etc/teams.scm b/etc/teams.scm index 8987b8b9c1..5d34729dd4 100755 --- a/etc/teams.scm +++ b/etc/teams.scm @@ -881,6 +881,7 @@ and the maven-build-system." "gnu/packages/node-xyz.scm" "gnu/packages/node.scm" "guix/build-system/node.scm" + "guix/build/json-utils.scm" "guix/build/node-build-system.scm" "guix/import/npm-binary.scm" "guix/scripts/import/npm-binary.scm"))) diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm index c07479b693..596e2cb3e4 100644 --- a/guix/build-system/node.scm +++ b/guix/build-system/node.scm @@ -43,6 +43,7 @@ (define %node-build-system-modules ;; Build-side modules imported by default. `((guix build node-build-system) + (guix build json-utils) ,@%default-gnu-imported-modules)) (define (default-node) @@ -99,6 +100,7 @@ (guile-json (default-guile-json)) (imported-modules %node-build-system-modules) (modules '((guix build node-build-system) + (guix build json-utils) (guix build utils)))) "Build SOURCE using NODE and INPUTS." (define builder diff --git a/guix/build/json-utils.scm b/guix/build/json-utils.scm new file mode 100644 index 0000000000..f80b1176e4 --- /dev/null +++ b/guix/build/json-utils.scm @@ -0,0 +1,164 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016, 2020 Jelle Licht <[email protected]> +;;; Copyright © 2019, 2021 Timothy Sample <[email protected]> +;;; Copyright © 2021, 2022 Philip McGrath <[email protected]> +;;; Copyright © 2024 Daniel Khodabakhsh <[email protected]> +;;; Copyright © 2026 Nicolas Graves <[email protected]> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix build json-utils) + #:use-module (guix build utils) + #:use-module (guix deprecation) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + #:use-module (ice-9 format) + #:use-module (ice-9 ftw) + #:use-module (ice-9 optargs) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (json) + #:use-module (srfi srfi-1) + #:export (with-atomic-json-file-replacement + modify-json + modify-json-fields + delete-fields + replace-fields + add-fields)) + +;;; +;;; 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 produce +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 #:ordered #t)) out #:pretty #t)))) + +(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* (modify-json-fields fields field-modifier + #:key + (field-path-mapper identity) + (insert? #f) + (strict? #t)) + "Return a procedure 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 @code{\"devDependencies.esbuild\"}, or a list of strings such +as @code{(list \"devDependencies\" \"esbuild\")}. + +FIELD-MODIFIER is a procedure called with three arguments: 1) the original +field-path, e.g. \"dependencies.typescript\", 2) the field's +surrounding (parent) JSON data, as an association list, and 3) the field +name (key), e.g. \"typescript\". The value it returns should be the modified +JSON data associated with the field; in other words, returning the second +argument without changing it is a no-op. + +FIELD-PATH-MAPPER is a procedure which instructs where the field-path is +located within the field structure. INSERT? allows the creation of the field +and any missing intermediate fields, while 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 (format #f "\ +invalid field value provided, expected string or list of strings, got ~s~%" + field-path)))))) + (let loop ((data package) + (field-path field-path)) + (let* ((key (car field-path)) + (field-missing? (not (assoc key data))) + (data (if (and field-missing? insert?) + (acons key '() data) + data))) + (if field-missing? + (if strict? + (error (format #f "key ~s was not found in data: ~y~%" + key 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) + (format #t "deleting field ~s, of value: ~y~%" + key (assoc-ref data key)) + (assoc-remove! data key)) + #:strict? strict?)) + +(define* (replace-fields fields #:key (strict? #t) insert?) + "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) + (let ((value (cdr field))) + (format #t "setting field ~s to value: ~y~%" key value) + (assoc-set! data key value))) + #:field-path-mapper (lambda (field) (car field)) + #:insert? insert? + #:strict? strict?)) + +(define* (add-fields fields) + "Like `replace-fields', but can insert new fields as well." + (replace-fields fields #:insert? #t)) + +;;; Local Variables: +;;; eval: (put 'with-atomic-json-file-replacement 'scheme-indent-function 1) +;;; End: diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm index 08623f9775..00384da2d4 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -25,6 +25,7 @@ (define-module (guix build node-build-system) #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build json-utils) #:use-module (guix build utils) #:use-module (ice-9 format) #:use-module (ice-9 ftw) @@ -39,43 +40,12 @@ delete-dependencies/except delete-dev-dependencies delete-dev-dependencies/except - delete-fields - add-fields - modify-json - modify-json-fields - node-build - replace-fields - with-atomic-json-file-replacement)) + node-build)) ;;; -;;; package.json modification procedures +;;; Helpers ;;; -(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 produce -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 #:ordered #t)) out #:pretty #t)))) - -(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 %dependency-keys '("devDependencies" "dependencies" @@ -125,97 +95,6 @@ dependencies." (delete-dependencies/except dependencies-to-preserve #:dependency-keys %dev-dependency-keys)) -(define* (modify-json-fields fields field-modifier - #:key - (field-path-mapper identity) - (insert? #f) - (strict? #t)) - "Return a procedure 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 @code{\"devDependencies.esbuild\"}, or a list of strings such -as @code{(list \"devDependencies\" \"esbuild\")}. - -FIELD-MODIFIER is a procedure called with three arguments: 1) the original -field-path, e.g. \"dependencies.typescript\", 2) the field's -surrounding (parent) JSON data, as an association list, and 3) the field -name (key), e.g. \"typescript\". The value it returns should be the modified -JSON data associated with the field; in other words, returning the second -argument without changing it is a no-op. - -FIELD-PATH-MAPPER is a procedure which instructs where the field-path is -located within the field structure. INSERT? allows the creation of the field -and any missing intermediate fields, while 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 (format #f "\ -invalid field value provided, expected string or list of strings, got ~s~%" - field-path)))))) - (let loop ((data package) - (field-path field-path)) - (let* ((key (car field-path)) - (field-missing? (not (assoc key data))) - (data (if (and field-missing? insert?) - (acons key '() data) - data))) - (if field-missing? - (if strict? - (error (format #f "key ~s was not found in data: ~y~%" - key 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) - (format #t "deleting field ~s, of value: ~y~%" - key (assoc-ref data key)) - (assoc-remove! data key)) - #:strict? strict?)) - -(define* (replace-fields fields #:key (strict? #t) insert?) - "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) - (let ((value (cdr field))) - (format #t "setting field ~s to value: ~y~%" key value) - (assoc-set! data key value))) - #:field-path-mapper (lambda (field) (car field)) - #:insert? insert? - #:strict? strict?)) - -(define* (add-fields fields) - "Like `replace-fields', but can insert new fields as well." - (replace-fields fields #:insert? #t)) - (define (delete-dev-dependencies) (delete-fields (list "devDependencies" "peerDependencies") #:strict? #f)) diff --git a/guix/build/tree-sitter-build-system.scm b/guix/build/tree-sitter-build-system.scm index 5819594f06..f19fc5f43c 100644 --- a/guix/build/tree-sitter-build-system.scm +++ b/guix/build/tree-sitter-build-system.scm @@ -19,6 +19,7 @@ (define-module (guix build tree-sitter-build-system) #:use-module ((guix build node-build-system) #:prefix node:) + #:use-module (guix build json-utils) #:use-module (guix build utils) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -48,7 +49,7 @@ "Rewrite dependencies in 'package.json'. We remove all runtime dependencies and replace development dependencies with tree-sitter grammar node modules." - (node:with-atomic-json-file-replacement + (with-atomic-json-file-replacement "package.json" (lambda (pkg-meta-alist) (map (match-lambda (("dependencies" dependencies ...) diff --git a/guix/import/npm-binary.scm b/guix/import/npm-binary.scm index 2cbd23ed02..333adaab55 100644 --- a/guix/import/npm-binary.scm +++ b/guix/import/npm-binary.scm @@ -25,6 +25,7 @@ #:use-module (gcrypt hash) #:use-module (gnu packages) #:use-module (guix base32) + #:use-module (guix build json-utils) #:use-module (guix http-client) #:use-module ((guix import git) #:select (get-tags)) #:use-module (guix import json)
