diff --git a/json.carp b/json.carp index f664536..6cd3b40 100644 --- a/json.carp +++ b/json.carp @@ -1485,35 +1485,44 @@ atomic: on failure `doc` is untouched and the error names the operation index. [(Array (Box JSON)) (Ref String) (Ref JSON) (Ref JSON)] (Array (Box JSON)))) + (private removed-members) + (hidden removed-members) + (defn removed-members [ops path am bm] + (Map.kv-reduce + &(fn [out k _] + (if (Map.contains? bm k) + out + (JSON.Patch.push-remove out &(JSON.Patch.member-path path k)))) + ops + am)) + + (private bucket-for) + (hidden bucket-for) + (defn bucket-for [m k] + (Array.unsafe-nth (Map.buckets m) + (Int.positive-mod (hash k) @(Map.n-buckets m)))) + + (private member-at) + (hidden member-at) + (defn member-at [b i] + (Box.peek (Pair.b (Array.unsafe-nth (Bucket.entries b) i)))) + (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)) + (Map.kv-reduce + &(fn [out k bv] + (let [p (JSON.Patch.member-path path k) + b (JSON.Patch.bucket-for am k) + i (Bucket.find b k)] + (if (Int.< i 0) + (JSON.Patch.push-op out "add" &p @(Box.peek bv)) + (JSON.Patch.diff-into out + &p + (JSON.Patch.member-at b i) + (Box.peek bv))))) + (JSON.Patch.removed-members ops path am bm) + bm)) (private diff-elems) (hidden diff-elems) @@ -1549,18 +1558,16 @@ atomic: on failure `doc` is untouched and the error names the operation index. 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)))) + (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)) + _ (if (JSON.= a b) ops (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. diff --git a/test/json.carp b/test/json.carp index bff83f3..87dde02 100644 --- a/test/json.carp +++ b/test/json.carp @@ -169,7 +169,33 @@ @"{\"/\":1,\"~\":2}" @"{\"\":1}" @"{\"-\":1,\"0\":2}" - @"{\"x\":{\"y/z\":[{\"~\":null},1]}}"]) + @"{\"x\":{\"y/z\":[{\"~\":null},1]}}" + @"true" + @"false" + @"\"\"" + @"{\"a\":[]}" + @"{\"a\":{}}" + @"{\"a\":[[]]}" + @"{\"a\":[{}]}" + @"{\"a\":{\"b\":[]}}" + @"{\"a\":true}" + @"{\"b\":2,\"a\":1}" + @"[[[[1]]]]" + @"[[[[2]]]]" + @"[[[[]]]]" + @"[[[[1],2]]]" + @"[1,[2,[3,[4]]]]" + @"[1,[2,[3,[5]]]]" + @"[0,1,2]" + @"[0,1,2,3,4,5]" + @"{\"d\":{\"d\":{\"d\":{\"d\":{\"v\":1}}}}}" + @"{\"d\":{\"d\":{\"d\":{\"d\":{\"v\":2}}}}}" + @"{\"d\":{\"d\":{\"d\":{\"d\":{}}}}}" + @"{\"d\":{\"d\":{\"d\":{\"d\":{\"v\":1,\"w\":2}}}}}" + @"{\"a\":1,\"b\":{\"c\":[1,2,{\"d\":null}]}}" + @"{\"a\":1,\"b\":{\"c\":[1,2,{\"d\":3}]}}" + @"{\"x\":{\"y/z\":[{\"~\":null},2]}}" + @"{\"a\":{\"b\":{\"c\":2}}}"]) (defn all-pairs-diff-roundtrip? [] (let-do [docs (diff-corpus) @@ -184,6 +210,24 @@ (IO.println &(fmt "diff does not round-trip: %s -> %s" a b)))))) ok)) +(defn self-diffs-empty? [] + (let-do [docs (diff-corpus) + ok true + n (Array.length &docs)] + (for [i 0 n] + (let [d (Array.unsafe-nth &docs i)] + (unless-do (patch-diff-eq? d d "[]") + (set! ok false) + (IO.println &(fmt "diff of %s with itself is not empty" d))))) + ok)) + +(defn deep-json [depth v] + (let-do [pre (the (Array String) []) + post (the (Array String) [])] + (for [i 0 depth] + (do (Array.push-back! &pre @"{\"n\":") (Array.push-back! &post @"}"))) + (fmt "%s%d%s" &(String.concat &pre) v &(String.concat &post)))) + (def rfc-doc (JSON.obj [(JSON.entry @"foo" @@ -2158,6 +2202,52 @@ break")) "str string with newline") (all-pairs-diff-roundtrip?) "applying a diff to its source yields the target for every pair of a corpus") + (assert-true test + (self-diffs-empty?) + "a document diffs to the empty patch against itself, at every kind") + + (assert-true test + (patch-diff-eq? "{\"a\":{\"b\":1}}" + "{\"a\":{}}" + "[{\"op\":\"remove\",\"path\":\"/a/b\"}]") + "a member emptied to {} loses its keys one at a time") + + (assert-true test + (patch-diff-eq? "{\"a\":[1]}" + "{\"a\":[]}" + "[{\"op\":\"remove\",\"path\":\"/a/0\"}]") + "a member emptied to [] loses its elements one at a time") + + (assert-true test + (patch-diff-eq? "{\"a\":1}" + "{\"a\":{}}" + "[{\"op\":\"replace\",\"path\":\"/a\",\"value\":{}}]") + "a scalar member becoming {} is a replace") + + (assert-true test + (patch-diff-eq? "{\"a\":{}}" + "{\"a\":[]}" + "[{\"op\":\"replace\",\"path\":\"/a\",\"value\":[]}]") + "an empty object member becoming [] is a replace") + + (assert-true test + (patch-diff-eq? "{\"a\":{},\"b\":1}" + "{\"a\":{},\"b\":2}" + "[{\"op\":\"replace\",\"path\":\"/b\",\"value\":2}]") + "a member that is an empty object in both emits nothing") + + (assert-true test + (patch-diff-eq? &(deep-json 120 1) + &(deep-json 120 2) + &(fmt + "[{\"op\":\"replace\",\"path\":\"%s\",\"value\":2}]" + &(String.repeat 120 "/n"))) + "diff points at the changed leaf of a deeply nested document") + + (assert-true test + (patch-diff-roundtrips? &(deep-json 120 1) &(deep-json 120 2)) + "a deep diff round-trips through apply") + ; the RFC 7386 Appendix A table (assert-true test (merge-eq? "{\"a\":\"b\"}" "{\"a\":\"c\"}" "{\"a\":\"c\"}")