Skip to content

Commit 82195ad

Browse files
bendlasbendlas
committed
Implement bidirectional map for prefix-xmlns mapping
1 parent 97b6d8c commit 82195ad

4 files changed

Lines changed: 142 additions & 5 deletions

File tree

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -62,10 +62,10 @@
6262
(keyword? ns) (name ns)
6363
:else (str ns)))
6464

65-
;; xmlns attributes get special treatment, as they are go into metadata and don't contribute to equality
65+
;; xmlns attributes get special treatment. they go into metadata, don't contribute to equality
6666
(def xmlns-uri "http://www.w3.org/2000/xmlns/")
6767
;; TODO find out if xml prefixed names need any special treatment too
68-
; (def xml-uri "http://www.w3.org/XML/1998/namespace")
68+
(def xml-uri "http://www.w3.org/XML/1998/namespace")
6969

7070
(extend-protocol AsQName
7171
Keyword

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

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
(ns clojure.data.xml.pu-map
2+
"Provides a bidirectional mapping for keeping track of prefix->uri mappings in xml namespaces.
3+
4+
This has the semantics of a basic key -> multiple values map + two special features, both of which are dictated by the xml standard:
5+
6+
- instead of a special dissoc, there is assoc to empty string or nil
7+
- there are two fixed, unique mappings:
8+
- \"xml\" <-> [\"http://www.w3.org/2000/xmlns/\"]
9+
- \"xmlns\" <-> [\"http://www.w3.org/XML/1998/namespace\"]"
10+
(:require [clojure.data.xml.name :as name]
11+
[clojure.string :as str]
12+
[clojure.core :as core])
13+
(:refer-clojure :exclude [assoc! dissoc! transient persistent! get assoc]))
14+
15+
(defn transient [{:keys [u->ps p->u]}]
16+
(core/assoc! (core/transient {})
17+
:p->u (core/transient p->u)
18+
:u->ps (core/transient u->ps)))
19+
20+
(defn persistent! [put]
21+
(core/persistent!
22+
(core/assoc! put
23+
:p->u (core/persistent! (core/get put :p->u))
24+
:u->ps (core/persistent! (core/get put :u->ps)))))
25+
26+
(defn- assoc-uri! [u->ps uri prefix]
27+
(core/assoc! u->ps uri
28+
(if-let [ps (core/get u->ps uri)]
29+
(conj ps prefix)
30+
[prefix])))
31+
32+
(defn- dissoc-uri! [u->ps uri prefix]
33+
(if-let [ps (seq (remove #{prefix} (core/get u->ps uri)))]
34+
(core/assoc! u->ps uri (vec ps))
35+
(core/dissoc! u->ps uri)))
36+
37+
(defn assoc! [{:as put :keys [p->u u->ps]} prefix uri]
38+
(when (or (core/get #{"xml" "xmlns"} prefix)
39+
(core/get #{name/xml-uri name/xmlns-uri} uri))
40+
(throw (ex-info "Mapping for xml: and xmlns: prefixes are fixed by the standard"
41+
{:attempted-mapping {:prefix prefix
42+
:uri uri}})))
43+
(let [prev-uri (core/get p->u prefix)]
44+
(core/assoc! put
45+
:p->u (if (str/blank? uri)
46+
(core/dissoc! p->u prefix)
47+
(core/assoc! p->u prefix uri))
48+
:u->ps (if (str/blank? uri)
49+
(dissoc-uri! u->ps prev-uri prefix)
50+
(cond
51+
(= uri prev-uri) u->ps
52+
(not prev-uri) (assoc-uri! u->ps uri prefix)
53+
:else (-> u->ps
54+
(dissoc-uri! prev-uri prefix)
55+
(assoc-uri! uri prefix)))))))
56+
57+
(defn get [{:keys [p->u]} prefix]
58+
(core/get p->u prefix))
59+
60+
(defn get-prefixes [{:keys [u->ps]} uri]
61+
(core/get u->ps uri))
62+
63+
(def get-prefix (comp first get-prefixes))
64+
65+
(defn assoc [put & {:as kvs}]
66+
(persistent!
67+
(reduce-kv assoc! (transient put) kvs)))
68+
69+
70+
;; TODO replace this with a deftype for memory savings
71+
(def EMPTY {:u->ps {name/xml-uri ["xml"]
72+
name/xmlns-uri ["xmlns"]}
73+
:p->u {"xml" name/xml-uri
74+
"xmlns" name/xmlns-uri}})

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

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
(ns clojure.data.xml.test-pu
2+
(:require [clojure.data.xml.pu-map :as pu]
3+
[clojure.data.xml.name :as name]
4+
[clojure.test :refer [deftest is are testing]]))
5+
6+
(deftest builtin-mappings
7+
(is (= name/xml-uri (pu/get pu/EMPTY "xml")))
8+
(is (= name/xmlns-uri (pu/get pu/EMPTY "xmlns")))
9+
(is (= ["xml"] (pu/get-prefixes pu/EMPTY name/xml-uri)))
10+
(is (= ["xmlns"] (pu/get-prefixes pu/EMPTY name/xmlns-uri)))
11+
(are [p u] (thrown? #?(:clj Exception :cljs js/Error) (pu/assoc pu/EMPTY p u))
12+
"xml" "_"
13+
"xmlns" "_"
14+
"_" name/xml-uri
15+
"_" name/xmlns-uri))
16+
17+
(deftest basic-operation
18+
(are [associated-groups expected-uris expected-prefixes]
19+
(let [pu (reduce (fn [pu* group] (apply pu/assoc pu* group))
20+
pu/EMPTY associated-groups)]
21+
(every? true?
22+
(apply concat
23+
(for [[prefix uri] (partition 2 expected-uris)]
24+
(is (= uri (pu/get pu prefix))))
25+
(for [[uri prefixes] (partition 2 expected-prefixes)]
26+
[(is (= prefixes (pu/get-prefixes pu uri)))
27+
(is (= (first prefixes) (pu/get-prefix pu uri)))]))))
28+
[]
29+
["wrong-prefix" nil
30+
"xml" name/xml-uri
31+
"xmlns" name/xmlns-uri]
32+
["wrong-uri" nil
33+
name/xml-uri ["xml"]
34+
name/xmlns-uri ["xmlns"]]
35+
36+
[["p" "U:"
37+
"q" "V:"]]
38+
["wrong-prefix" nil
39+
"xml" name/xml-uri
40+
"xmlns" name/xmlns-uri
41+
"p" "U:"
42+
"q" "V:"]
43+
["wrong-uri" nil
44+
name/xml-uri ["xml"]
45+
name/xmlns-uri ["xmlns"]
46+
"U:" ["p"]
47+
"V:" ["q"]]
48+
49+
[["p" "U:"
50+
"q" "V:"]
51+
["r" "U:"
52+
"s" "V:"]
53+
["t" "U:"]
54+
["p" ""
55+
"q" ""]]
56+
["p" nil
57+
"q" nil
58+
"r" "U:"]
59+
["U:" ["r" "t"]
60+
"V:" ["s"]]))

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

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
[clojure.data.xml :as xml]
44
clojure.data.xml.test-cljs-basic
55
clojure.data.xml.test-cljs-extended
6-
clojure.data.xml.test-equiv))
6+
clojure.data.xml.test-equiv
7+
clojure.data.xml.test-pu))
78

89
(def ^:dynamic *results*)
910

@@ -19,13 +20,15 @@
1920
(binding [*results* nil]
2021
(println "Running Basic Tests")
2122
(test/run-tests 'clojure.data.xml.test-cljs-basic
22-
'clojure.data.xml.test-equiv)
23+
'clojure.data.xml.test-equiv
24+
'clojure.data.xml.test-pu)
2325
(pr-str *results*)))
2426

2527
(defn ^:export -main []
2628
(binding [*results* nil]
2729
(println "Running Basic Tests")
28-
(test/run-tests 'clojure.data.xml.test-cljs-basic)
30+
(test/run-tests 'clojure.data.xml.test-cljs-basic
31+
'clojure.data.xml.test-pu)
2932
(println "Extending DOM Objects and running again + extended tests")
3033
(xml/extend-dom-as-data!)
3134
(test/testing "with extended native dom"

0 commit comments

Comments
 (0)