DXML-27 serialize XMLSchema built-in data types

serialize well-known java/clojure data types with a correspondence
in https://www.w3.org/TR/xmlschema-2/#built-in-datatypes

Author: bendlas

pom.xml

@@ -36,6 +36,12 @@
   </parent>
 
   <dependencies>
+    <dependency>
+      <groupId>org.clojure</groupId>
+      <artifactId>data.codec</artifactId>
+      <version>0.1.0</version>
+      <scope>compile</scope>
+    </dependency>
     <dependency>
       <groupId>org.clojure</groupId>
       <artifactId>test.check</artifactId>

project.clj

@@ -3,6 +3,7 @@
   :test-paths ["src/test/clojure" "src/test/clojurescript"]
   :resource-paths ["src/test/resources" "target/gen-resources"]
   :dependencies [[org.clojure/clojure "1.8.0"]
+                 [org.clojure/data.codec "0.1.0"]
                  [org.clojure/clojurescript "1.9.473"]
                  [com.cemerick/piggieback "0.2.1"]
                  [org.clojure/tools.nrepl "0.2.12"]

src/main/clojure/clojure/data/xml/event.clj

@@ -10,11 +10,15 @@
   "Data type for xml pull events"
   {:author "Herwig Hochleitner"}
   (:require [clojure.data.xml.protocols :refer
-             [EventGeneration gen-event next-events]]
+             [EventGeneration gen-event next-events xml-str]]
             [clojure.data.xml.name :refer [merge-nss separate-xmlns]]
             [clojure.data.xml.node :refer [element* cdata xml-comment]]
-            [clojure.data.xml.impl :refer [extend-protocol-fns]])
-  (:import (clojure.data.xml.node Element CData Comment)))
+            [clojure.data.xml.impl :refer [extend-protocol-fns compile-if]])
+  (:import (clojure.data.xml.node Element CData Comment)
+           (clojure.lang Sequential IPersistentMap Keyword)
+           (java.net URI URL)
+           (java.util Date)
+           (javax.xml.namespace QName)))
 
 (definline element-nss* [element]
   `(get (meta ~element) :clojure.data.xml/nss {}))
@@ -30,6 +34,7 @@
 (defrecord CharsEvent [str])
 (defrecord CDataEvent [str])
 (defrecord CommentEvent [str])
+(defrecord QNameEvent [qn])
 
 ;; EndElementEvent doesn't have any data, so make it a singleton
 (deftype EndElementEvent [])
@@ -45,26 +50,35 @@
                      attrs #(->StartElementEvent
                              tag %1 (merge-nss (element-nss* element) %2) nil)))
        :next-events (fn elem-next-events [{:keys [tag content]} next-items]
-                      (list* content end-element-event next-items))}]
+                      (list* content end-element-event next-items))}
+      string-event-generation {:gen-event (comp ->CharsEvent #'xml-str)
+                               :next-events second-arg}
+      qname-event-generation {:gen-event ->QNameEvent
+                              :next-events second-arg}]
   (extend-protocol-fns
    EventGeneration
    (StartElementEvent EndElementEvent CharsEvent CDataEvent CommentEvent)
    {:gen-event identity
     :next-events second-arg}
-   (String Boolean Number nil)
-   {:gen-event (comp ->CharsEvent str)
-    :next-events second-arg}
+   (String Boolean Number (Class/forName "[B") Date URI URL nil)
+   string-event-generation
+   (Keyword QName) qname-event-generation
    CData
    {:gen-event (comp ->CDataEvent :content)
     :next-events second-arg}
    Comment
    {:gen-event (comp ->CommentEvent :content)
     :next-events second-arg}
-   (clojure.lang.IPersistentMap Element) elem-event-generation))
+   (IPersistentMap Element) elem-event-generation)
+  (compile-if
+   (Class/forName "java.time.Instant")
+   (extend java.time.Instant
+     EventGeneration
+     string-event-generation)
+   nil))
 
 (extend-protocol EventGeneration
-  
-  clojure.lang.Sequential
+  Sequential
   (gen-event   [coll]
     (gen-event (first coll)))
   (next-events [coll next-items]

src/main/clojure/clojure/data/xml/impl.clj

@@ -8,7 +8,8 @@
 
 (ns clojure.data.xml.impl
   "Shared private code for data.xml namespaces"
-  {:author "Herwig Hochleitner"})
+  {:author "Herwig Hochleitner"}
+  (:require [clojure.data.codec.base64 :as b64]))
 
 (defn- var-form? [form]
   (and (seq? form) (= 'var (first form))))
@@ -49,3 +50,17 @@
                  `(let [~mm ~mmap]
                     ~@(map gen-extend type (repeat mm))))
                (gen-extend type mmap))))))
+
+(defmacro compile-if
+  "Evaluate `exp` and if it returns logical true and doesn't error, expand to
+  `then`.  Else expand to `else`.
+
+  see clojure.core.reducers"
+  [exp then else]
+  (if (try (eval exp)
+           (catch Throwable _ false))
+    `(do ~then)
+    `(do ~else)))
+
+(defn b64-encode [ba]
+  (String. (b64/encode ba)))

src/main/clojure/clojure/data/xml/jvm/emit.clj

@@ -12,16 +12,22 @@
   (:require (clojure.data.xml
              [name :refer [qname-uri qname-local separate-xmlns gen-prefix *gen-prefix-counter*]]
              [pu-map :as pu]
+             [protocols :refer [AsXmlString xml-str]]
+             [impl :refer [extend-protocol-fns b64-encode compile-if]]
              event)
             [clojure.string :as str])
   (:import (java.io OutputStreamWriter Writer StringWriter)
            (java.nio.charset Charset)
            (java.util.logging Logger Level)
-           (javax.xml.namespace NamespaceContext)
+           (javax.xml.namespace NamespaceContext QName)
            (javax.xml.stream XMLStreamWriter XMLOutputFactory)
            (javax.xml.transform OutputKeys Transformer
                                 TransformerFactory)
-           (clojure.data.xml.event StartElementEvent EndElementEvent CharsEvent CDataEvent CommentEvent)))
+           (clojure.data.xml.event StartElementEvent EndElementEvent CharsEvent CDataEvent CommentEvent QNameEvent)
+           (clojure.lang BigInt)
+           (java.net URI URL)
+           (java.util Date)
+           (java.text DateFormat SimpleDateFormat)))
 
 (def logger (Logger/getLogger "clojure.data.xml"))
 
@@ -36,14 +42,25 @@
                     {:stream-encoding (.getEncoding stream)
                      :declared-encoding xml-encoding}))))
 
+(defn- prefix-for [qn pu]
+  (or (pu/get-prefix pu (qname-uri qn))
+      (throw (ex-info "Auto-generating prefixes is not supported for content-qnames. Please declare all URIs used in content qnames."
+                      {:qname qn
+                       :uri (qname-uri qn)}))))
+
+(defn- attr-str [value pu]
+  (if (or (keyword? value) (instance? QName value))
+    (str (prefix-for value pu) ":" (qname-local value))
+    (xml-str value)))
+
 (defn- emit-attrs [^XMLStreamWriter writer pu attrs]
   (reduce-kv
    (fn [_ attr value]
      (let [uri (qname-uri attr)
            local (qname-local attr)]
        (if (str/blank? uri)
-         (.writeAttribute writer                         local value)
-         (.writeAttribute writer (pu/get-prefix pu uri) uri local value)))
+         (.writeAttribute writer                            local (attr-str value pu))
+         (.writeAttribute writer (pu/get-prefix pu uri) uri local (attr-str value pu))))
      _)
    nil attrs))
 
@@ -129,7 +146,44 @@
   CDataEvent
   (emit-event [{:keys [str]} writer s] (emit-cdata str writer) s)
   CommentEvent
-  (emit-event [{:keys [str]} writer s] (.writeComment writer str) s))
+  (emit-event [{:keys [str]} writer s] (.writeComment writer str) s)
+  QNameEvent
+  (emit-event [{:keys [qn]} writer pu-stack]
+    (.writeCharacters writer (prefix-for qn (first pu-stack)))
+    (.writeCharacters writer ":")
+    (.writeCharacters writer (qname-local qn))
+    pu-stack))
+
+(def ^:private ^ThreadLocal thread-local-utc-date-format
+  ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access.
+  ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335
+  (proxy [ThreadLocal] []
+    (initialValue []
+      (doto (SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00")
+        ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT)
+        (.setTimeZone (java.util.TimeZone/getTimeZone "GMT"))))))
+
+(extend-protocol-fns
+ AsXmlString
+ String {:xml-str identity}
+ (Boolean Byte Character Short Integer Long Float Double
+  BigInteger BigDecimal BigInt URI URL nil) {:xml-str str})
+
+(extend-protocol AsXmlString
+  (Class/forName "[B")
+  (xml-str [ba] (b64-encode ba))
+  Date
+  (xml-str [d] (let [^DateFormat utc-format (.get thread-local-utc-date-format)]
+                 (.format utc-format d)))
+  clojure.lang.Ratio
+  (xml-str [r] (str (.decimalValue r))))
+
+(compile-if
+ (Class/forName "java.time.Instant")
+ (extend-protocol AsXmlString
+   java.time.Instant
+   (xml-str [i] (xml-str (Date/from i))))
+ nil)
 
 ;; Writers
 

src/main/clojure/clojure/data/xml/protocols.cljc

@@ -24,3 +24,6 @@
 
 (defprotocol AsElements
   (as-elements [expr] "Return a seq of elements represented by an expression."))
+
+(defprotocol AsXmlString
+  (xml-str [node] "Serialize atribute value or content node"))