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