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\"}")