diff --git a/src/cljs/clojure/data.cljs b/src/cljs/clojure/data.cljs new file mode 100644 index 0000000000..11a84af313 --- /dev/null +++ b/src/cljs/clojure/data.cljs @@ -0,0 +1,162 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +(ns + ^{:author "Stuart Halloway", + :doc "Non-core data functions."} + clojure.data + (:require [clojure.set :as set])) + +(declare diff) + +(defn- atom-diff + "Internal helper for diff." + [a b] + (if (= a b) [nil nil a] [a b nil])) + +;; for big things a sparse vector class would be better +(defn- vectorize + "Convert an associative-by-numeric-index collection into + an equivalent vector, with nil for any missing keys" + [m] + (when (seq m) + (reduce + (fn [result [k v]] (assoc result k v)) + (vec (repeat (apply max (keys m)) nil)) + m))) + +(defn- diff-associative-key + "Diff associative things a and b, comparing only the key k." + [a b k] + (let [va (get a k) + vb (get b k) + [a* b* ab] (diff va vb) + in-a (contains? a k) + in-b (contains? b k) + same (and in-a in-b + (or (not (nil? ab)) + (and (nil? va) (nil? vb))))] + [(when (and in-a (or (not (nil? a*)) (not same))) {k a*}) + (when (and in-b (or (not (nil? b*)) (not same))) {k b*}) + (when same {k ab}) + ])) + +(defn- diff-associative + "Diff associative things a and b, comparing only keys in ks (if supplied)." + ([a b] + (diff-associative a b (set/union (keys a) (keys b)))) + ([a b ks] + (reduce + (fn [diff1 diff2] + (doall (map merge diff1 diff2))) + [nil nil nil] + (map + (partial diff-associative-key a b) + ks)))) + +(defn- diff-sequential + [a b] + (vec (map vectorize (diff-associative + (if (vector? a) a (vec a)) + (if (vector? b) b (vec b)) + (range (max (count a) (count b))))))) + +(defn- diff-set + [a b] + [(not-empty (set/difference a b)) + (not-empty (set/difference b a)) + (not-empty (set/intersection a b))]) + +(defprotocol EqualityPartition + "Implementation detail. Subject to change." + (equality-partition [x] "Implementation detail. Subject to change.")) + +(defprotocol Diff + "Implementation detail. Subject to change." + (diff-similar [a b] "Implementation detail. Subject to change.")) + +(extend-protocol EqualityPartition + nil + (equality-partition [x] :atom) + + string + (equality-partition [x] :atom) + + number + (equality-partition [x] :atom) + + array + (equality-partition [x] :sequential) + + function + (equality-partition [x] :atom) + + boolean + (equality-partition [x] :atom) + + default + (equality-partition [x] + (cond + (satisfies? IMap x) :map + (satisfies? ISet x) :set + (satisfies? ISequential x) :sequential + :default :atom))) + +(extend-protocol Diff + nil + (diff-similar [a b] + (atom-diff a b)) + + string + (diff-similar [a b] + (atom-diff a b)) + + number + (diff-similar [a b] + (atom-diff a b)) + + array + (diff-similar [a b] + (diff-sequential a b)) + + function + (diff-similar [a b] + (atom-diff a b)) + + boolean + (diff-similar [a b] + (atom-diff a b)) + + default + (diff-similar [a b] + ((case (equality-partition a) + :atom atom-diff + :set diff-set + :sequential diff-sequential + :map diff-associative) + a b))) + +(defn diff + "Recursively compares a and b, returning a tuple of + [things-only-in-a things-only-in-b things-in-both]. + Comparison rules: + + * For equal a and b, return [nil nil a]. + * Maps are subdiffed where keys match and values differ. + * Sets are never subdiffed. + * All sequential things are treated as associative collections + by their indexes, with results returned as vectors. + * Everything else (including strings!) is treated as + an atom and compared for equality." + [a b] + (if (= a b) + [nil nil a] + (if (= (equality-partition a) (equality-partition b)) + (diff-similar a b) + (atom-diff a b)))) + diff --git a/test/cljs/clojure/data_test.cljs b/test/cljs/clojure/data_test.cljs new file mode 100644 index 0000000000..009b1ccbd5 --- /dev/null +++ b/test/cljs/clojure/data_test.cljs @@ -0,0 +1,22 @@ +(ns clojure.data-test + (:require [clojure.data :refer [diff]])) + +(defn test-data [] + (assert (= [nil nil nil] (diff nil nil))) + (assert (= [1 2 nil] (diff 1 2))) + (assert (= [nil nil [1 2 3]] (diff [1 2 3] '(1 2 3)))) + (assert (= [1 [:a :b] nil] (diff 1 [:a :b]))) + (assert (= [{:a 1} :b nil] (diff {:a 1} :b))) + (assert (= [:team #{:p1 :p2} nil] (diff :team #{:p1 :p2}))) + (assert (= [{0 :a} [:a] nil] (diff {0 :a} [:a]))) + (assert (= [nil [nil 2] [1]] (diff [1] [1 2]))) + (assert (= [nil nil [1 2]] (diff [1 2] (into-array [1 2])))) + (assert (= [#{:a} #{:b} #{:c :d}] (diff #{:a :c :d} #{:b :c :d}))) + (assert (= [nil nil {:a 1}] (diff {:a 1} {:a 1}))) + (assert (= [{:a #{2}} {:a #{4}} {:a #{3}}] (diff {:a #{2 3}} {:a #{3 4}}))) + (assert (= [nil nil [1 2]] (diff [1 2] (into-array [1 2])))) + (assert (= [nil nil [1 2]] (diff (into-array [1 2]) [1 2]))) + (assert (= [{:a {:c [1]}} {:a {:c [0]}} {:a {:c [nil 2] :b 1}}] + (diff {:a {:b 1 :c [1 2]}} {:a {:b 1 :c [0 2]}}))) + (assert (= [{:a nil} {:a false} {:b nil :c false}] + (diff {:a nil :b nil :c false} {:a false :b nil :c false})))) diff --git a/test/cljs/test_runner.cljs b/test/cljs/test_runner.cljs index fa6b14f7ca..7b2c23be52 100644 --- a/test/cljs/test_runner.cljs +++ b/test/cljs/test_runner.cljs @@ -4,6 +4,7 @@ [cljs.binding-test :as binding-test] [cljs.ns-test :as ns-test] [clojure.string-test :as string-test] + [clojure.data-test :as data-test] [cljs.macro-test :as macro-test] [cljs.letfn-test :as letfn-test] [foo.ns-shadow-test :as ns-shadow-test])) @@ -13,6 +14,7 @@ (core-test/test-stuff) (reader-test/test-reader) (string-test/test-string) +(data-test/test-data) (binding-test/test-binding) (ns-test/test-ns) (macro-test/test-macros)