From cbec2a580486cd811bece8718d136e382898327d Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Sat, 22 Aug 2026 18:15:07 +0200 Subject: [PATCH] Add JSON.Patch.diff, RFC 6902 patch generation `JSON.Patch` could apply a patch but not produce one, while for the far simpler RFC 7386 the library ships both directions. Anything that has to describe a change, an HTTP PATCH client, an audit log, a sync protocol, was left hand-writing operation objects and getting pointer escaping and array index shifting right for itself. `JSON.Patch.diff` walks two documents together and emits `add` for a key only in the target, `remove` for a key only in the source, and nothing for members the two share. Objects and array elements are recursed into, so an edit deep in a document costs one pointer-addressed operation rather than a copy of the value enclosing it; everything else that differs becomes a `replace`, including a pair of documents of different kinds, which replaces the whole document at the empty pointer. It returns a `JSON.Arr` of operation objects, so the result feeds straight into `apply` and serializes with `JSON.str` without a new type. Two details a hand-written generator gets wrong are pinned by name. Paths go through `JSON.Pointer.escape`, so a key containing `/` or `~` addresses the member it names instead of a nonexistent one. A shrinking array is trimmed in descending index order, because removing an element shifts every later one left and an ascending trim would leave the remaining pointers naming the wrong elements. Tests assert the exact patch for each shape and check the round trip `apply(a, diff(a, b))` = `b` over all 576 ordered pairs of a 24 document corpus covering nested objects, arrays that grow and shrink, kind changes, keys needing `~0`/`~1`, empty documents, and `null` values, which RFC 6902 can express and a merge patch cannot. Dropping the escaping, swapping `add` for `replace` on a new key, swapping `remove` for `add` on a dropped one, trimming ascending, and dropping the equality short-circuit each fail between two and seven of them. --- README.md | 23 ++++++++ docs/JSON.Patch.html | 27 +++++++++ json.carp | 125 ++++++++++++++++++++++++++++++++++++++++- test/json.carp | 131 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 305 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 54eb548..a0bea86 100644 --- a/README.md +++ b/README.md @@ -135,6 +135,29 @@ rejected with `DepthLimitExceeded`, and a patch may insert at most `json-max-patch-nodes` nodes beyond the combined size of the document and the patch before `SizeLimitExceeded`. Neither binds on a hand-written patch. +`JSON.Patch.diff` goes the other way, building a patch that takes one document +to another: + +```clojure +(def a (Result.unsafe-from-success (JSON.parse "{\"a\":1,\"b\":{\"c\":2}}"))) +(def b (Result.unsafe-from-success (JSON.parse "{\"a\":1,\"b\":{\"c\":3}}"))) + +(JSON.Patch.diff &a &b) ; => [{"op":"replace","path":"/b/c","value":3}] +(JSON.Patch.apply &a &(JSON.Patch.diff &a &b)) ; => (Success b) +``` + +Objects are compared member by member and arrays element by element, so a +change deep inside a document costs one operation addressed by pointer rather +than a copy of the value enclosing it. A key only in the target becomes an +`add`, a key only in the source a `remove`, and anything else that differs a +`replace`, including two documents of different kinds, which replace the whole +document at the empty pointer. Keys are escaped, and a shrinking array is +trimmed in descending index order so that every pointer still names the +element it did before the trim. + +Every operation `diff` emits is one `apply` accepts, so the round trip holds +for any pair of documents, `null` members and array edits included. + ### JSON Merge Patch `JSON.merge-patch` implements [RFC 7386](https://www.rfc-editor.org/rfc/rfc7386), diff --git a/docs/JSON.Patch.html b/docs/JSON.Patch.html index eca5feb..d1520b2 100644 --- a/docs/JSON.Patch.html +++ b/docs/JSON.Patch.html @@ -96,6 +96,33 @@

atomic: on failure doc is untouched and the error names the operation index.

(JSON.Patch.apply &doc &patch)

+

+ +
+ +

+ diff +

+ +
+ defn +
+

+ (Fn [(Ref JSON a), (Ref JSON a)] JSON) +

+ 
+                        (diff a b)
+
+

+

builds an RFC 6902 patch taking a to b, the inverse of +apply: applying the result to a returns b for any two documents.

+

Objects are compared member by member, emitting add for a key only in b, +remove for a key only in a, and nothing for members the two share. Arrays +are compared element by element, growing with add and shrinking with +remove. Everything else that differs becomes a replace, so two documents +of different kinds diff to one replace of the whole document.

+

(JSON.Patch.apply &a &(JSON.Patch.diff &a &b))

+

diff --git a/json.carp b/json.carp index 3c5a850..fdee43d 100644 --- a/json.carp +++ b/json.carp @@ -1449,7 +1449,130 @@ atomic: on failure `doc` is untouched and the error names the operation index. (JSON.Arr ops) (JSON.Patch.apply-ops @doc ops) _ (Result.Error - (JSON.PatchError.init -1 (JSON.PatchErrorKind.NotAnArray))))))) + (JSON.PatchError.init -1 (JSON.PatchErrorKind.NotAnArray))))) + + (private push-op) + (hidden push-op) + (defn push-op [ops name path v] + (Array.push-back ops + (Box.init + (JSON.obj + [(JSON.entry @"op" (JSON.Str @name)) + (JSON.entry @"path" (JSON.Str @path)) + (JSON.entry @"value" v)])))) + + (private push-remove) + (hidden push-remove) + (defn push-remove [ops path] + (Array.push-back ops + (Box.init + (JSON.obj + [(JSON.entry @"op" (JSON.Str @"remove")) + (JSON.entry @"path" (JSON.Str @path))])))) + + (private member-path) + (hidden member-path) + (defn member-path [path k] (fmt "%s/%s" path &(JSON.Pointer.escape k))) + + (private index-path) + (hidden index-path) + (defn index-path [path i] (fmt "%s/%d" path i)) + + (private diff-into) + (hidden diff-into) + (register diff-into + (Fn + [(Array (Box JSON)) (Ref String) (Ref JSON) (Ref JSON)] + (Array (Box JSON)))) + + (private diff-members) + (hidden diff-members) + (defn diff-members [ops path am bm] + (let-do [out ops + aks (Map.keys am) + bks (Map.keys bm) + bvs (Map.vals bm) + i 0 + an (Array.length &aks) + bn (Array.length &bks)] + (while-do (Int.< i an) + (let [k (Array.unsafe-nth &aks i)] + (set! out + (if (Map.contains? bm k) + out + (JSON.Patch.push-remove out &(JSON.Patch.member-path path k))))) + (set! i (Int.inc i))) + (set! i 0) + (while-do (Int.< i bn) + (let [k (Array.unsafe-nth &bks i) + bv (Box.peek (Array.unsafe-nth &bvs i)) + p (JSON.Patch.member-path path k)] + (set! out + (match (Map.get-maybe am k) + (Maybe.Nothing) (JSON.Patch.push-op out "add" &p @bv) + (Maybe.Just av) + (JSON.Patch.diff-into out &p (Box.peek &av) bv)))) + (set! i (Int.inc i))) + out)) + + (private diff-elems) + (hidden diff-elems) + (defn diff-elems [ops path aa ba] + (let-do [out ops + an (Array.length aa) + bn (Array.length ba) + common (Int.min an bn) + i 0] + (while-do (Int.< i common) + (let [p (JSON.Patch.index-path path i)] + (set! out + (JSON.Patch.diff-into out + &p + (Box.peek (Array.unsafe-nth aa i)) + (Box.peek (Array.unsafe-nth ba i))))) + (set! i (Int.inc i))) + (set! i common) + (while-do (Int.< i bn) + (let [p (JSON.Patch.index-path path i)] + (set! out + (JSON.Patch.push-op out + "add" + &p + @(Box.peek (Array.unsafe-nth ba i))))) + (set! i (Int.inc i))) + ; descending, so no removal shifts the element the next pointer names + (set! i (Int.dec an)) + (while-do (Int.>= i bn) + (let [p (JSON.Patch.index-path path i)] + (set! out (JSON.Patch.push-remove out &p))) + (set! i (Int.dec i))) + out)) + + (defn diff-into [ops path a b] + (if (JSON.= a b) + ops + (match-ref a + (JSON.Obj am) + (match-ref b + (JSON.Obj bm) (JSON.Patch.diff-members ops path am bm) + _ (JSON.Patch.push-op ops "replace" path @b)) + (JSON.Arr aa) + (match-ref b + (JSON.Arr ba) (JSON.Patch.diff-elems ops path aa ba) + _ (JSON.Patch.push-op ops "replace" path @b)) + _ (JSON.Patch.push-op ops "replace" path @b)))) + + (doc diff "builds an RFC 6902 patch taking `a` to `b`, the inverse of +`apply`: applying the result to `a` returns `b` for any two documents. + +Objects are compared member by member, emitting `add` for a key only in `b`, +`remove` for a key only in `a`, and nothing for members the two share. Arrays +are compared element by element, growing with `add` and shrinking with +`remove`. Everything else that differs becomes a `replace`, so two documents +of different kinds diff to one `replace` of the whole document. + + (JSON.Patch.apply &a &(JSON.Patch.diff &a &b))") + (defn diff [a b] (JSON.Arr (JSON.Patch.diff-into [] "" a b))))) (defmodule JSON (register merge-patch (Fn [JSON (Ref JSON)] JSON)) diff --git a/test/json.carp b/test/json.carp index 759c16e..b096c7a 100644 --- a/test/json.carp +++ b/test/json.carp @@ -135,6 +135,55 @@ &(Result.unsafe-from-error (JSON.Patch.apply &(parse-json src) &(parse-json patch))))) +(defn patch-diff-eq? [a b expected] + (= &(JSON.Patch.diff &(parse-json a) &(parse-json b)) &(parse-json expected))) + +(defn patch-diff-roundtrips? [a b] + (let [ja (parse-json a) + jb (parse-json b)] + (match (JSON.Patch.apply &ja &(JSON.Patch.diff &ja &jb)) + (Result.Success r) (= &r &jb) + (Result.Error e) (do (ignore e) false)))) + +(defn diff-corpus [] + [@"null" + @"1" + @"\"x\"" + @"[]" + @"{}" + @"[1,2,3,4]" + @"[1]" + @"[[1],[2],[3]]" + @"[{\"a\":1},{\"b\":[1,2]},3]" + @"[{\"a\":2},{\"b\":[1,2,3]},3,4]" + @"[null,null]" + @"{\"a\":1}" + @"{\"a\":null}" + @"{\"a\":1,\"b\":2}" + @"{\"a\":{\"b\":{\"c\":1}}}" + @"{\"a\":{\"b\":{}}}" + @"{\"a\":[1,2,3]}" + @"{\"a\":[3,2,1]}" + @"{\"a/b\":1}" + @"{\"m~n\":2}" + @"{\"/\":1,\"~\":2}" + @"{\"\":1}" + @"{\"-\":1,\"0\":2}" + @"{\"x\":{\"y/z\":[{\"~\":null},1]}}"]) + +(defn all-pairs-diff-roundtrip? [] + (let-do [docs (diff-corpus) + ok true + n (Array.length &docs)] + (for [i 0 n] + (for [j 0 n] + (let [a (Array.unsafe-nth &docs i) + b (Array.unsafe-nth &docs j)] + (unless-do (patch-diff-roundtrips? a b) + (set! ok false) + (IO.println &(fmt "diff does not round-trip: %s -> %s" a b)))))) + ok)) + (def rfc-doc (JSON.obj [(JSON.entry @"foo" @@ -2027,6 +2076,88 @@ break")) "str string with newline") _ false) "move may not, which RFC 6902 4.4 requires") + (assert-true test + (patch-diff-eq? "{\"a\":1}" "{\"a\":1}" "[]") + "diff of equal documents is the empty patch") + + (assert-true test + (patch-diff-eq? "{\"a\":1}" + "{\"a\":2}" + "[{\"op\":\"replace\",\"path\":\"/a\",\"value\":2}]") + "diff replaces a changed member") + + (assert-true test + (patch-diff-eq? "{\"a\":1}" + "{\"a\":1,\"b\":2}" + "[{\"op\":\"add\",\"path\":\"/b\",\"value\":2}]") + "diff adds a member only the target has") + + (assert-true test + (patch-diff-eq? "{\"a\":1,\"b\":2}" + "{\"a\":1}" + "[{\"op\":\"remove\",\"path\":\"/b\"}]") + "diff removes a member only the source has") + + (assert-true test + (patch-diff-eq? "{\"a\":{\"b\":1,\"c\":2}}" + "{\"a\":{\"b\":9,\"c\":2}}" + "[{\"op\":\"replace\",\"path\":\"/a/b\",\"value\":9}]") + "diff points at the changed leaf instead of replacing its object") + + (assert-true test + (patch-diff-eq? "{\"a/b\":1}" + "{\"a/b\":9}" + "[{\"op\":\"replace\",\"path\":\"/a~1b\",\"value\":9}]") + "diff escapes a / in a key as ~1") + + (assert-true test + (patch-diff-eq? "{\"m~n\":1}" + "{}" + "[{\"op\":\"remove\",\"path\":\"/m~0n\"}]") + "diff escapes a ~ in a key as ~0") + + (assert-true test + (patch-diff-eq? "{\"a\":1}" + "[1,2]" + "[{\"op\":\"replace\",\"path\":\"\",\"value\":[1,2]}]") + "documents of different kinds diff to a whole-document replace") + + (assert-true test + (patch-diff-eq? "1" "2" "[{\"op\":\"replace\",\"path\":\"\",\"value\":2}]") + "two scalars diff to a whole-document replace") + + (assert-true test + (patch-diff-eq? "[1]" + "[1,2,3]" + "[{\"op\":\"add\",\"path\":\"/1\",\"value\":2},{\"op\":\"add\",\"path\":\"/2\",\"value\":3}]") + "diff grows an array one index at a time") + + (assert-true test + (patch-diff-eq? "[1,2,3,4]" + "[1]" + "[{\"op\":\"remove\",\"path\":\"/3\"},{\"op\":\"remove\",\"path\":\"/2\"},{\"op\":\"remove\",\"path\":\"/1\"}]") + "diff shrinks an array in descending index order") + + (assert-true test + (patch-diff-eq? "[{\"a\":1},{\"b\":2}]" + "[{\"a\":9},{\"b\":2}]" + "[{\"op\":\"replace\",\"path\":\"/0/a\",\"value\":9}]") + "diff recurses into array elements") + + (assert-true test + (patch-diff-eq? "{\"a\":1}" + "{\"a\":null}" + "[{\"op\":\"replace\",\"path\":\"/a\",\"value\":null}]") + "a member set to null is a replace, not a remove") + + (assert-true test + (patch-diff-roundtrips? "{}" "{\"a\":null}") + "a member newly set to null round-trips, which merge-diff cannot") + + (assert-true test + (all-pairs-diff-roundtrip?) + "applying a diff to its source yields the target for every pair of a corpus") + ; the RFC 7386 Appendix A table (assert-true test (merge-eq? "{\"a\":\"b\"}" "{\"a\":\"c\"}" "{\"a\":\"c\"}")