Add JSON.Patch.diff, RFC 6902 patch generation

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),

docs/JSON.Patch.html

@@ -96,6 +96,33 @@ <h3 id="apply">
 atomic: on failure <code>doc</code> is untouched and the error names the operation index.</p>
 <p>(JSON.Patch.apply &amp;doc &amp;patch)</p>
 
+                    </p>
+                </div>
+                <div class="binder">
+                    <a class="anchor" href="#diff">
+                        <h3 id="diff">
+                            diff
+                        </h3>
+                    </a>
+                    <div class="description">
+                        defn
+                    </div>
+                    <p class="sig">
+                        (Fn [(Ref JSON a), (Ref JSON a)] JSON)
+                    </p>
+                    <pre class="args">
+                        (diff a b)
+                    </pre>
+                    <p class="doc">
+                        <p>builds an RFC 6902 patch taking <code>a</code> to <code>b</code>, the inverse of
+<code>apply</code>: applying the result to <code>a</code> returns <code>b</code> for any two documents.</p>
+<p>Objects are compared member by member, emitting <code>add</code> for a key only in <code>b</code>,
+<code>remove</code> for a key only in <code>a</code>, and nothing for members the two share. Arrays
+are compared element by element, growing with <code>add</code> and shrinking with
+<code>remove</code>. Everything else that differs becomes a <code>replace</code>, so two documents
+of different kinds diff to one <code>replace</code> of the whole document.</p>
+<p>(JSON.Patch.apply &amp;a &amp;(JSON.Patch.diff &amp;a &amp;b))</p>
+
                     </p>
                 </div>
             </div>

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

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