Make JSON.merge-diff linear in depth: O(size × depth) instead of O(size × depth²)

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.")

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