guix_mirror_bot pushed a commit to branch master
in repository guix.
commit b4fa99716020c59ed65512bac6e7e66146f6d88d
Author: Nicolas Graves <[email protected]>
AuthorDate: Wed Mar 18 08:17:47 2026 +0100
guix: json-utils: Rewrite and deprecate modify-json, delete-fields.
This commit is pushing for the drop of the optional file argument in
modify-json which is confusing too specific for such a general
function. Still support but deprecate the old style.
* guix/build-system/node.scm
(not-config?): New helper procedure.
(%node-build-system-modules): Add modules necessary for deprecation.
* guix/build/json-utils.scm
(modify-json*, delkw): New procedures.
(modify-json): Warn in the case of the former syntax.
(delete-fields): Deprecate in favor of...
(delete-json-fields): ... deprecated from delete-fields.
(replace-fields): Deprecate in favor of...
(replace-json-fields): ... deprecated from replace-fields.
(add-fields): Deprecate in favor of...
(add-json-fields): ... deprecated from replace-fields.
Change-Id: Ieb0642cfb8274bd1d044d0539cbfa0fe02793f2d
Signed-off-by: Jelle Licht <[email protected]>
---
guix/build-system/node.scm | 14 ++++++
guix/build/json-utils.scm | 92 ++++++++++++++++++++++++++++------------
guix/build/node-build-system.scm | 4 +-
3 files changed, 81 insertions(+), 29 deletions(-)
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 596e2cb3e47..4fdd03ade16 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -22,14 +22,17 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system node)
+ #:use-module ((guix self) #:select (make-config.scm))
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix gexp)
+ #:use-module (guix modules)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
+ #:use-module (ice-9 match)
#:export (%default-lockfiles
%node-build-system-modules
node-build
@@ -40,9 +43,20 @@
"yarn.lock"
"npm-shrinkwrap.json"))
+(define not-config?
+ ;; Select (guix …) and (gnu …) modules, except (guix config).
+ (match-lambda
+ (('guix 'config) #f)
+ (('guix _ ...) #t)
+ (('gnu _ ...) #t)
+ (_ #f)))
+
(define %node-build-system-modules
;; Build-side modules imported by default.
`((guix build node-build-system)
+ ((guix config) => ,(make-config.scm))
+ ,@(source-module-closure '((guix deprecation))
+ #:select? not-config?)
(guix build json-utils)
,@%default-gnu-imported-modules))
diff --git a/guix/build/json-utils.scm b/guix/build/json-utils.scm
index f80b1176e4d..ad31dcb8dac 100644
--- a/guix/build/json-utils.scm
+++ b/guix/build/json-utils.scm
@@ -32,12 +32,16 @@
#:use-module (ice-9 regex)
#:use-module (json)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:export (with-atomic-json-file-replacement
modify-json
modify-json-fields
delete-fields
+ delete-json-fields
replace-fields
- add-fields))
+ replace-json-fields
+ add-fields
+ add-json-fields))
;;;
;;; JSON modification procedures
@@ -52,21 +56,48 @@ a value to be written as JSON to the 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)))
+;; This is the function we eventually want to migrate to.
+(define* (modify-json* file #:rest modifications)
+ "Modify JSON FILE with successive callbacks."
+ (with-atomic-json-file-replacement file
+ (apply compose modifications)))
+
+;; Copied and adapted from (guix utils).
+;; To be removed after modify-json deprecation period.
+(define (delkw kw lst)
+ "Remove KW and its associated value from LST, a keyword/value list such
+as '(#:foo 1 #:bar 2)."
+ (let loop ((lst lst)
+ (result '()))
+ (match lst
+ (()
+ (reverse result))
+ (((? (cute eq? <> kw)) value . rest)
+ (append (reverse result) rest))
+ ((head . tail)
+ (loop tail (cons* head result))))))
+
+;; This is a deprecated version of the function that ought to be
+;; removed in favor of modify-json*'s content eventually.
+;; On removal, also remove the (guix deprecation) modules and their closures
+;; from node-build-system imported-modules.
+(define modify-json
+ (lambda* args
+ (cond
+ ;; Syntax from modify-json*
+ ((and (pair? args) (string? (car args)) (file-exists? (car args)))
+ (apply modify-json* args))
+ ;; Former syntax, #:file set.
+ ((memq '#:file args)
+ => (lambda (file-args)
+ (warning (G_ "'modify-json' 'file' keyword argument is deprecated,\
+ pass the file as the first argument instead~%"))
+ (let-keywords (take file-args 2) #f ((file "unreached-default"))
+ (apply modify-json* file (delkw #:file args)))))
+ ;; Former syntax, #:file unset.
+ (else
+ (warning (G_ "'modify-json' requires a file as the first argument~%"))
+ (apply modify-json* "package.json" args)))))
(define* (modify-json-fields fields field-modifier
#:key
@@ -122,13 +153,13 @@ invalid field value provided, expected string or list of
strings, got ~s~%"
package
fields)))
-(define* (delete-fields fields #:key (strict? #t))
+(define* (delete-json-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\"))"
+ (delete-json-fields
+ '((\"path\" \"to\" \"field\")
+ \"path.to.other.field\"))"
(modify-json-fields
fields
(lambda (_ data key)
@@ -137,14 +168,16 @@ invalid field value provided, expected string or list of
strings, got ~s~%"
(assoc-remove! data key))
#:strict? strict?))
-(define* (replace-fields fields #:key (strict? #t) insert?)
+(define-deprecated/alias delete-fields delete-json-fields)
+
+(define* (replace-json-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\")))"
+ (replace-json-fields
+ '(((\"path\" \"to\" \"field\") \"new field value\")
+ (\"path.to.other.field\" \"new field value\")))"
(modify-json-fields
fields
(lambda (field data key)
@@ -155,10 +188,15 @@ invalid field value provided, expected string or list of
strings, got ~s~%"
#:insert? insert?
#:strict? strict?))
-(define* (add-fields fields)
- "Like `replace-fields', but can insert new fields as well."
- (replace-fields fields #:insert? #t))
+(define-deprecated/alias replace-fields replace-json-fields)
+
+(define* (add-json-fields fields)
+ "Like `replace-json-fields', but can insert new fields as well."
+ (replace-json-fields fields #:insert? #t))
+
+(define-deprecated/alias add-fields add-json-fields)
;;; Local Variables:
;;; eval: (put 'with-atomic-json-file-replacement 'scheme-indent-function 1)
+;;; eval: (put 'modify-json* 'scheme-indent-function 1)
;;; End:
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 00384da2d41..42dfa9918d9 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -96,8 +96,8 @@ dependencies."
#:dependency-keys %dev-dependency-keys))
(define (delete-dev-dependencies)
- (delete-fields (list "devDependencies" "peerDependencies")
- #:strict? #f))
+ (delete-json-fields (list "devDependencies" "peerDependencies")
+ #:strict? #f))
;;;
;;; Phases.
