Skip to content

Commit adce289

Browse files
bendlasbendlas
committed
DXML-38 Implement MapEquivalence for xml elements
We have to reimplement most of defrecord in a deftype, in order to have proper equivalence to element maps.
1 parent e8eee2d commit adce289

5 files changed

Lines changed: 179 additions & 20 deletions

File tree

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ From 0.2.0-alpha1 to 0.2.0-alpha2
33
- Remove QName defrecord from Clojurescript
44
- Rename canonical-name to as-qname
55
- Remove to-qname
6+
- xml nodes now implement map equality
67

78
From 0.1.0-beta3 to 0.2.0-alpha1
89
- Define uniform mapping of xml namespaces to clojure namespaces via percent-encoding

‎src/main/clojure/clojure/data/xml/node.cljc‎

Lines changed: 154 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -9,11 +9,57 @@
99
(ns clojure.data.xml.node
1010
"Data types for xml nodes: Element, CData and Comment"
1111
{:author "Herwig Hochleitner"}
12-
(:require [clojure.data.xml.name :refer [as-qname]]))
12+
(:require [clojure.data.xml.name :refer [as-qname]])
13+
#?(:clj (:import (clojure.lang IHashEq IObj ILookup IKeywordLookup Counted
14+
Associative Seqable IPersistentMap
15+
APersistentMap RecordIterator RT
16+
MapEquivalence)
17+
(java.io Serializable Writer)
18+
(java.util Map))))
19+
20+
#?
21+
(:clj
22+
;; recreate cljs' caching-hash macro
23+
(defmacro caching-hash [this hash-fn hash-field]
24+
`(do (when-not ~hash-field
25+
(set! ~hash-field (~hash-fn ~this)))
26+
~hash-field)))
1327

1428
;; Parsed data format
1529
;; Represents a node of an XML tree
16-
(defrecord Element [tag attrs content]
30+
31+
;; We implement a custom deftype for elements
32+
;; it is similar to (defrecord Element [tag attrs content])
33+
;; but we override its hash and equality to be compatible with
34+
;; clojure's hash-maps
35+
;; see http://dev.clojure.org/jira/browse/CLJ-2084
36+
;; also, elements don't have an extmap and degrade to hash-maps also
37+
;; when assoc'ing unknown keys
38+
39+
(deftype Element [tag attrs content meta
40+
#?(:clj ^:volatile-mutable hash
41+
:cljs ^:mutable hash)]
42+
43+
;; serializing/cloning, hashing, equality, iteration
44+
45+
#?@
46+
(:clj
47+
[Serializable
48+
MapEquivalence
49+
IHashEq
50+
(hasheq [this] (caching-hash this APersistentMap/mapHasheq hash))
51+
Iterable
52+
(iterator [this] (RecordIterator. this [:tag :attrs :content] (RT/iter nil)))]
53+
:cljs
54+
[ICloneable
55+
(-clone [_] (Element. tag attrs content meta hash))
56+
IHash
57+
(-hash [this] (caching-hash this hash-unordered-coll hash))
58+
IEquiv
59+
(-equiv [this other] (or (identical? this other)
60+
^boolean (js/cljs.core.equiv_map this other)))
61+
IIterable
62+
(-iterator [this] (RecordIter. 0 this 3 [:tag :attrs :content] (nil-iter)))])
1763
Object
1864
(toString [_]
1965
(let [qname (as-qname tag)]
@@ -23,22 +69,119 @@
2369
attrs)
2470
(if (seq content)
2571
(concat [">"] content ["</" qname ">"])
26-
["/>"]))))))
72+
["/>"])))))
73+
#?@(:clj
74+
[(hashCode [this] (caching-hash this APersistentMap/mapHash hash))
75+
(equals [this other] (APersistentMap/mapEquals this other))
76+
IPersistentMap
77+
(equiv [this other] (APersistentMap/mapEquals this other))])
78+
79+
;; Main collection interfaces, that are included in IPersistentMap,
80+
;; but are separate protocols in cljs
81+
82+
#?(:cljs ILookup)
83+
(#?(:clj valAt :cljs -lookup) [this k]
84+
(#?(:clj .valAt :cljs -lookup)
85+
this k nil))
86+
(#?(:clj valAt :cljs -lookup) [this k nf]
87+
(case k
88+
:tag tag
89+
:attrs attrs
90+
:content content
91+
nf))
92+
#?(:cljs ICounted)
93+
(#?(:clj count :cljs -count) [this] 3)
94+
#?(:cljs ICollection)
95+
(#?(:clj cons :cljs -conj) [this entry]
96+
(conj (with-meta {:tag tag :attrs attrs :content content} meta)
97+
entry))
98+
#?(:cljs IAssociative)
99+
(#?(:clj assoc :cljs -assoc) [this k v]
100+
(case k
101+
:tag (Element. v attrs content meta nil)
102+
:attrs (Element. tag v content meta nil)
103+
:content (Element. tag attrs v meta nil)
104+
(with-meta {:tag tag :attrs attrs :content content k v} meta)))
105+
#?(:cljs IMap)
106+
(#?(:clj without :cljs -dissoc) [this k]
107+
(with-meta
108+
(case k
109+
:tag {:attrs attrs :content content}
110+
:attrs {:tag tag :content content}
111+
:content {:tag tag :attrs attrs}
112+
this)
113+
meta))
114+
#?@(:cljs
115+
[ISeqable
116+
(-seq [this]
117+
(seq [[:tag tag] [:attrs attrs] [:content content]]))]
118+
:clj
119+
[(seq [this] (iterator-seq (.iterator this)))])
120+
121+
;; j.u.Map and included interfaces
122+
#?@(:clj
123+
[Map
124+
(entrySet [this] (set this))
125+
(values [this] (vals this))
126+
(keySet [this] (set (keys this)))
127+
(get [this k] (.valAt this k))
128+
(containsKey [this k] (case k (:tag :attrs :content) true false))
129+
(containsValue [this v] (boolean (some #{v} (vals this))))
130+
(isEmpty [this] false)
131+
(size [this] 3)])
132+
133+
;; Metadata interface
134+
135+
#?(:clj IObj :cljs IMeta)
136+
(#?(:clj meta :cljs -meta) [this] meta)
137+
#?(:cljs IWithMeta)
138+
(#?(:clj withMeta :cljs -with-meta) [this next-meta]
139+
(Element. tag attrs content next-meta hash))
140+
141+
;; cljs printing is protocol-based
142+
143+
#?@
144+
(:cljs
145+
[IPrintWithWriter
146+
(-pr-writer [this writer opts]
147+
(-write writer "#xml/element{:tag ")
148+
(-pr-writer tag writer opts)
149+
(when-not (empty? attrs)
150+
(-write writer ", :attrs ")
151+
(-pr-writer attrs writer opts))
152+
(when-not (empty? content)
153+
(-write writer ", :content ")
154+
(pr-sequential-writer writer -pr-writer "[" " " "]" opts content))
155+
(-write writer "}"))]))
156+
157+
;; clj printing is a multimethod
158+
159+
#?
160+
(:clj
161+
(defmethod print-method Element [{:keys [tag attrs content]} ^Writer writer]
162+
(.write writer "#xml/element{:tag ")
163+
(print-method tag writer)
164+
(when-not (empty? attrs)
165+
(.write writer ", :attrs ")
166+
(print-method attrs writer))
167+
(when-not (empty? content)
168+
(.write writer ", :content [")
169+
(print-method (first content) writer)
170+
(doseq [c (next content)]
171+
(.write writer " ")
172+
(print-method c writer))
173+
(.write writer "]"))
174+
(.write writer "}")))
175+
27176
(defrecord CData [content])
28177
(defrecord Comment [content])
29178

30-
#?(:cljs ;; http://dev.clojure.org/jira/browse/CLJS-1859
31-
(extend-type Element
32-
IEquiv
33-
(-equiv [el o]
34-
(js/cljs.core.equiv_map el o))))
35-
36179
(defn element*
37180
"Create an xml element from a content collection and optional metadata"
38181
([tag attrs content meta]
39182
(Element. tag (or attrs {}) (remove nil? content) meta nil))
40183
([tag attrs content]
41-
(Element. tag (or attrs {}) (remove nil? content))))
184+
(Element. tag (or attrs {}) (remove nil? content) nil nil)))
42185

43186
#?(:clj
44187
;; Compiler macro for inlining the two constructors
@@ -47,7 +190,7 @@
47190
([tag attrs content meta]
48191
`(Element. ~tag (or ~attrs {}) (remove nil? ~content) ~meta nil))
49192
([tag attrs content]
50-
`(Element. ~tag (or ~attrs {}) (remove nil? ~content))))))
193+
`(Element. ~tag (or ~attrs {}) (remove nil? ~content) nil nil)))))
51194

52195
(defn element
53196
"Create an xml Element from content varargs"

‎src/test/clojure/clojure/data/xml/test_entities.clj‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -35,15 +35,15 @@
3535
(deftest prevent-xxe-by-default
3636
(testing "To prevent XXE attacks, exernal entities by default resolve to nil"
3737
(let [parsed (parse-vulnerable-file)
38-
expected #clojure.data.xml.node.Element{:tag :foo
39-
:attrs {}
40-
:content ()}]
38+
expected {:tag :foo
39+
:attrs {}
40+
:content ()}]
4141
(is (= expected parsed)))))
4242

4343
(deftest allow-external-entities-if-required
4444
(testing "If explicitly enabled, external entities are property resolved"
4545
(let [parsed (parse-vulnerable-file :supporting-external-entities true)
46-
expected #clojure.data.xml.node.Element{:tag :foo
47-
:attrs {}
48-
:content ("root_password\n")}]
46+
expected {:tag :foo
47+
:attrs {}
48+
:content ["root_password\n"]}]
4949
(is (= expected parsed)))))

‎src/test/clojure/clojure/data/xml/test_equiv.cljc‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
(ns clojure.data.xml.test-equiv
2+
(:require [clojure.data.xml :refer [element qname]]
3+
[clojure.test :refer [deftest is are testing]]))
4+
5+
(deftest test-node-equivalence
6+
(are [repr1 repr2] (and (is (= repr1 repr2))
7+
(is (= (hash repr1) (hash repr2))))
8+
(element :foo) {:tag :foo :attrs {} :content []}
9+
(element (qname "DAV:" "foo")) {:tag (qname "DAV:" "foo") :attrs {} :content []}
10+
(element :foo {:a "b"}) {:tag :foo :attrs {:a "b"} :content []}
11+
(element :foo {:a "b"} "a" "b") {:tag :foo :attrs {:a "b"} :content ["a" "b"]}))

‎src/test/clojurescript/clojure/data/xml/test_cljs.cljs‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@
22
(:require [cljs.test :as test]
33
[clojure.data.xml :as xml]
44
clojure.data.xml.test-cljs-basic
5-
clojure.data.xml.test-cljs-extended))
5+
clojure.data.xml.test-cljs-extended
6+
clojure.data.xml.test-equiv))
67

78
(def ^:dynamic *results*)
89

@@ -17,7 +18,8 @@
1718
(set! *print-err-fn* js/print)
1819
(binding [*results* nil]
1920
(println "Running Basic Tests")
20-
(test/run-tests 'clojure.data.xml.test-cljs-basic)
21+
(test/run-tests 'clojure.data.xml.test-cljs-basic
22+
'clojure.data.xml.test-equiv)
2123
(pr-str *results*)))
2224

2325
(defn ^:export -main []
@@ -27,5 +29,7 @@
2729
(println "Extending DOM Objects and running again + extended tests")
2830
(xml/extend-dom-as-data!)
2931
(test/testing "with extended native dom"
30-
(test/run-tests 'clojure.data.xml.test-cljs-basic 'clojure.data.xml.test-cljs-extended))
32+
(test/run-tests 'clojure.data.xml.test-cljs-basic
33+
'clojure.data.xml.test-cljs-extended
34+
'clojure.data.xml.test-equiv))
3135
*results*))

0 commit comments

Comments
 (0)