guix_mirror_bot pushed a commit to branch master
in repository guix.
commit c123100515ee2f213c16d9f77ae0b212dbf21a08
Author: Maxim Cournoyer <[email protected]>
AuthorDate: Mon Aug 3 09:32:46 2026 +0900
build/json-utils: Raise an error on preexisting key with `add-json-fields'.
* guix/build/json-utils.scm (&modify-json-preexisting-key-error): New
condition. Export condition predicates.
(modify-json-fields): Raise an error when attempting to inserting a
pre-existing key.
* tests/json-utils.scm ("add-json-fields, preexisting field")
("add-json-fields, preexisting multi-level field"): New tests.
---
guix/build/json-utils.scm | 48 +++++++++++++++++++++++++++++++++++------------
tests/json-utils.scm | 9 +++++++++
2 files changed, 45 insertions(+), 12 deletions(-)
diff --git a/guix/build/json-utils.scm b/guix/build/json-utils.scm
index 027f919bdab..555600dbf6b 100644
--- a/guix/build/json-utils.scm
+++ b/guix/build/json-utils.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2021, 2022 Philip McGrath <[email protected]>
;;; Copyright © 2024 Daniel Khodabakhsh <[email protected]>
;;; Copyright © 2026 Nicolas Graves <[email protected]>
+;;; Copyright © 2026 Maxim Cournoyer <[email protected]>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -44,7 +45,13 @@
add-json-fields
&modify-json-invalid-field-value-error
- &modify-json-missing-key-error))
+ modify-json-invalid-field-value-error?
+
+ &modify-json-missing-key-error
+ modify-json-missing-key-error?
+
+ &modify-json-preexisting-key-error
+ modify-json-preexisting-key-error?))
;;;
;;; JSON modification procedures
@@ -123,6 +130,11 @@ as '(#:foo 1 #:bar 2)."
(key modify-json-missing-key-error-key)
(data modify-json-missing-key-error-data))
+(define-condition-type &modify-json-preexisting-key-error &modify-json-error
+ modify-json-preexisting-key-error?
+ (key modify-json-preexisting-key-error-key)
+ (data modify-json-preexisting-key-error-data))
+
(define* (modify-json-fields fields field-modifier
#:key
(field-path-mapper identity)
@@ -143,8 +155,10 @@ 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."
+and any missing intermediate fields. STRICT? raises a
+@code{&modify-json-missing-key-error} condition if the exact field-path is not
+found in the data, or a @code{&modify-json-preexisting-key-error} when the key
+already exists when inserting."
(lambda (package)
(fold
(lambda (field package)
@@ -165,24 +179,34 @@ invalid field value provided, expected string or list of
strings, got ~s~%")
(field-path field-path))
(let* ((key (car field-path))
(field-missing? (not (assoc key data)))
+ (field-leaf? (= 1 (length field-path)))
(data (if (and field-missing? insert?)
(acons key '() data)
data)))
- (if (and field-missing? (not insert?))
- (if strict?
+ (when strict?
+ (if insert?
+ (when (and field-leaf? (not field-missing?))
+ (raise (make-compound-condition
+ (condition (&modify-json-preexisting-key-error
+ (key key)
+ (data data)))
+ (formatted-message
+ (G_ "key ~s already exists in data: ~y~%")
+ key data))))
+ (when field-missing?
(raise (make-compound-condition
(condition (&modify-json-missing-key-error
(key key)
(data data)))
(formatted-message
(G_ "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)))))))))
+ key data))))))
+
+ (if field-leaf?
+ (field-modifier field data key)
+ (assoc-set! data key
+ (loop (assoc-ref data key)
+ (cdr field-path))))))))
package
fields)))
diff --git a/tests/json-utils.scm b/tests/json-utils.scm
index 3e33d182d3a..1c9a8847862 100644
--- a/tests/json-utils.scm
+++ b/tests/json-utils.scm
@@ -186,6 +186,15 @@ captures the written output as a string."
"devDependencies")
"@types/dummy"))
+(test-error "add-json-fields, preexisting field"
+ &modify-json-preexisting-key-error
+ (modify-json* (add-json-fields '(("name" . "duplicate")))))
+
+(test-error "add-json-fields, preexisting multi-level field"
+ &modify-json-preexisting-key-error
+ (modify-json* (add-json-fields '(("devDependencies.qux"
+ . "^9.0.0")))))
+
;;;
;;; modify-json-fields
;;;
