diff --git a/json.carp b/json.carp index 3c5a850..d94aa3b 100644 --- a/json.carp +++ b/json.carp @@ -1487,48 +1487,49 @@ than merged, so a patch reaches neither into an array nor a `null` value. (private deleted-members) (hidden deleted-members) (defn deleted-members [am bm] - (let-do [m (the (Map String (Box JSON)) {}) - ks (Map.keys am) - null (Box.init (JSON.Null)) - i 0 - n (Array.length &ks)] - (while-do (Int.< i n) - (let [k (Array.unsafe-nth &ks i)] - (set! m (if (Map.contains? bm k) m (Map.put m k &null)))) - (set! i (Int.inc i))) - m)) - - (register merge-diff (Fn [(Ref JSON) (Ref JSON)] JSON)) + (Map.kv-reduce + &(fn [m k _] + (if (Map.contains? bm k) + m + (let [null (Box.init (JSON.Null))] (Map.put m k &null)))) + (the (Map String (Box JSON)) {}) + am)) + + (private diff-map) + (hidden diff-map) + (register diff-map + (Fn + [(Ref (Map String (Box JSON))) (Ref (Map String (Box JSON)))] + (Map String (Box JSON)))) (private diff-member) (hidden diff-member) - (register diff-member - (Fn - [(Ref (Map String (Box JSON))) (Ref String) (Ref JSON)] - (Maybe (Box JSON)))) (defn diff-member [am k bv] (match (Map.get-maybe am k) (Maybe.Nothing) (Maybe.Just (Box.init @bv)) (Maybe.Just av) - (if (JSON.= (Box.peek &av) bv) - (Maybe.Nothing) - (Maybe.Just (Box.init (JSON.merge-diff (Box.peek &av) bv)))))) - - (private diff-objs) - (hidden diff-objs) - (defn diff-objs [am bm] - (let-do [m (JSON.deleted-members am bm) - ks (Map.keys bm) - vs (Map.vals bm) - i 0 - n (Array.length &ks)] - (while-do (Int.< i n) - (let [k (Array.unsafe-nth &ks i)] - (let [d (JSON.diff-member am k (Box.peek (Array.unsafe-nth &vs i)))] - (set! m - (match d (Maybe.Nothing) m (Maybe.Just bx) (Map.put m k &bx))))) - (set! i (Int.inc i))) - (JSON.Obj m))) + (match-ref (Box.peek &av) + (JSON.Obj sam) + (match-ref bv + (JSON.Obj sbm) + (let [d (JSON.diff-map sam sbm)] + (if (Map.empty? &d) + (Maybe.Nothing) + (Maybe.Just (Box.init (JSON.Obj d))))) + _ (Maybe.Just (Box.init @bv))) + _ + (if (JSON.= (Box.peek &av) bv) + (Maybe.Nothing) + (Maybe.Just (Box.init @bv)))))) + + (defn diff-map [am bm] + (Map.kv-reduce + &(fn [m k bv] + (match (JSON.diff-member am k (Box.peek bv)) + (Maybe.Nothing) m + (Maybe.Just bx) (Map.put m k &bx))) + (JSON.deleted-members am bm) + bm)) (doc merge-diff "builds the smallest RFC 7386 merge patch taking `a` to `b`, emitting `null` for the members `b` drops and omitting the ones it leaves @@ -1538,7 +1539,8 @@ one does not survive the round trip through `merge-patch`. (JSON.merge-patch @&a &(JSON.merge-diff &a &b))") (defn merge-diff [a b] (match-ref a - (JSON.Obj am) (match-ref b (JSON.Obj bm) (JSON.diff-objs am bm) _ @b) + (JSON.Obj am) + (match-ref b (JSON.Obj bm) (JSON.Obj (JSON.diff-map am bm)) _ @b) _ @b))) (doc to-json "converts a Carp value to its JSON representation.") diff --git a/test/json.carp b/test/json.carp index 759c16e..92f45ba 100644 --- a/test/json.carp +++ b/test/json.carp @@ -2124,6 +2124,48 @@ break")) "str string with newline") (diff-eq? "{\"a\":1}" "[1,2]" "[1,2]") "merge-diff against a non-object is that document") + (assert-true test + (diff-eq? "{\"a\":{},\"b\":1}" "{\"a\":{},\"b\":2}" "{\"b\":2}") + "merge-diff omits a member that is an empty object in both documents") + + (assert-true test + (diff-eq? "{\"a\":{\"b\":1}}" "{\"a\":{}}" "{\"a\":{\"b\":null}}") + "merge-diff empties a member with a null, not with an empty object") + + (assert-true test + (diff-eq? "{\"a\":{}}" "{\"a\":{\"b\":1}}" "{\"a\":{\"b\":1}}") + "merge-diff fills an empty object member") + + (assert-true test + (diff-eq? "{\"a\":[]}" "{\"a\":{}}" "{\"a\":{}}") + "merge-diff emits an empty object when an array becomes one") + + (assert-true test + (diff-eq? "{\"a\":{}}" "{\"a\":[]}" "{\"a\":[]}") + "merge-diff replaces an empty object member with an array") + + (assert-true test + (diff-eq? + "{\"a\":{\"b\":{\"c\":1}},\"z\":{\"y\":{\"x\":2}}}" + "{\"a\":{\"b\":{\"c\":9}},\"z\":{\"y\":{\"x\":2}}}" + "{\"a\":{\"b\":{\"c\":9}}}") + "merge-diff omits a deep object member whose whole subtree is unchanged") + + (assert-true test + (diff-eq? "{\"a\":{\"b\":null,\"c\":1}}" + "{\"a\":{\"b\":null,\"c\":2}}" + "{\"a\":{\"c\":2}}") + "merge-diff omits a null-valued member the two documents share") + + (assert-true test + (diff-eq? "{\"a\":{\"b\":null}}" "{\"a\":{\"b\":1}}" "{\"a\":{\"b\":1}}") + "merge-diff replaces a null-valued member") + + (assert-true test + (diff-roundtrips? "{\"a\":{\"b\":{}},\"c\":1}" + "{\"a\":{\"b\":{},\"d\":2},\"c\":1}") + "an untouched nested empty object round-trips") + (assert-true test (diff-roundtrips? "{\"title\":\"Goodbye!\",\"author\":{\"givenName\":\"John\",\"familyName\":\"Doe\"},\"tags\":[\"example\",\"sample\"],\"content\":\"This will be unchanged\"}"