(ns

^{:author "Cosmin Stejerean, Sean Corfield",

:doc "Support for recursively converting Java beans to Clojure and vice versa."}

clojure.java.data

(:require [clojure.string :as str]))

(set! *warn-on-reflection* true)

(def ^:dynamic

*to-java-object-missing-setter*

"Specify the behavior of missing setters in to-java in the

:ignore)

(defmulti to-java

"Convert Clojure data to an instance of the specified Java class.

(fn [destination-type value] [destination-type (class value)]))

(defmulti from-java

"Convert a Java object to a Clojure map."

class)

(defmulti from-java-deep

"Convert a Java object to a Clojure map (converting deeply).

(fn [obj _] (class obj)))

(defmulti from-java-shallow

"Convert a Java object to a Clojure map (but do not convert deeply).

(fn [obj _] (class obj)))

(defn- get-property-descriptors [clazz]

(.getPropertyDescriptors (java.beans.Introspector/getBeanInfo clazz)))

(comment

(mapv bean (.getPropertyDescriptors (java.beans.Introspector/getBeanInfo java.sql.Statement))))

(defn- is-getter [^java.lang.reflect.Method method]

(and method

(= 0 (alength ^"[Ljava.lang.Class;" (.getParameterTypes method)))))

(defn- make-getter-fn [^java.lang.reflect.Method method]

(fn [instance]

(from-java (.invoke method instance nil))))

(defn- make-deep-getter-fn [^java.lang.reflect.Method method opts]

(fn [instance]

(from-java-deep (.invoke method instance nil) opts)))

(defn- make-shallow-getter-fn [^java.lang.reflect.Method method]

(fn [instance]

(let [r (.invoke method instance nil)]

(if (instance? Boolean r)

(boolean r)

r))))

(defn- add-getter-fn [the-map ^java.beans.PropertyDescriptor prop-descriptor]

(let [name (.getName prop-descriptor)

method (.getReadMethod prop-descriptor)]

(if (and (is-getter method) (not (= "class" name)))

(assoc the-map (keyword name) (make-getter-fn method))

the-map)))

(defn- add-deep-getter-fn [the-map ^java.beans.PropertyDescriptor prop-descriptor opts]

(let [name (.getName prop-descriptor)

method (.getReadMethod prop-descriptor)]

(if (and (is-getter method) (not (= "class" name)))

(assoc the-map (keyword name) (make-deep-getter-fn method opts))

the-map)))

(defn- add-shallow-getter-fn [the-map ^java.beans.PropertyDescriptor prop-descriptor]

(let [name (.getName prop-descriptor)

method (.getReadMethod prop-descriptor)]

(if (and (is-getter method) (not (= "class" name)))

(assoc the-map (keyword name) (make-shallow-getter-fn method))

the-map)))

(defn- is-setter [^java.lang.reflect.Method method]

(and method (= 1 (alength (. method (getParameterTypes))))))

(defn- get-setter-type [^java.lang.reflect.Method method]

(get (.getParameterTypes method) 0))

(defn- make-setter-fn [^java.lang.reflect.Method method]

(fn [instance value]

(.invoke method instance (into-array [(to-java (get-setter-type method) value)]))))

(defn- add-setter-fn [the-map ^java.beans.PropertyDescriptor prop-descriptor]

(let [name (.getName prop-descriptor)

method (.getWriteMethod prop-descriptor)]

(if (is-setter method)

(assoc the-map (keyword name) (make-setter-fn method))

the-map)))

(defn- add-array-methods [^Class acls]

(let [cls (.getComponentType acls)

to (fn [_ sequence] (into-array cls (map (partial to-java cls)

sequence)))

from (fn [obj] (map from-java obj))

from-deep (fn [obj opts] (map #(from-java-deep % opts) obj))

from-shallow (fn [obj opts] (map #(from-java-shallow % opts) obj))]

(.addMethod ^clojure.lang.MultiFn to-java [acls Iterable] to)

(.addMethod ^clojure.lang.MultiFn from-java acls from)

(.addMethod ^clojure.lang.MultiFn from-java-deep acls from-deep)

(.addMethod ^clojure.lang.MultiFn from-java-shallow acls from-shallow)

{:to to :from from :from-deep from-deep :from-shallow from-shallow}))

(defn- find-matching-constructors [^Class clazz args]

(let [n (count args)]

(filter (fn [^java.lang.reflect.Constructor ctr]

(and (= n (.getParameterCount ctr))

(let [pts (map vector (.getParameterTypes ctr) args)]

(every? (fn [[^Class pt arg]]

;; watch out for boxed types in Clojure

;; passed to primitive constructor parameters

(cond (.isPrimitive pt)

(and arg ; cannot pass nil to primitive

(or (instance? Number arg)

(instance? Boolean arg)))

(nil? arg)

true ; null is assignable to any non-primitive

:else

(.isAssignableFrom pt (class arg))))

pts))))

(.getConstructors clazz))))

(defn- find-constructor ^java.lang.reflect.Constructor [^Class clazz args]

(let [candidates (find-matching-constructors clazz args)]

(condp = (count candidates)

0 (throw (IllegalArgumentException.

(str (.getName clazz) " has no matching constructor"

" for the given argument list")))

1 (first candidates)

(throw (IllegalArgumentException.

(str (.getName clazz) " constructor is ambiguous"

" for the given argument list"))))))

(comment

(find-constructor String ["arg"])

(find-constructor String [(.getBytes "arg")])

(find-constructor String [(.getBytes "arg") (int 0) (int 3)])

(find-constructor String ["too" "many" "arguments"]))

(defmethod to-java :default [^Class cls value]

(if (.isArray cls)

;; no method for this array type yet

((:to (add-array-methods cls)) cls value)

value))

(defmethod to-java [Enum String] [^Class enum value]

(.invoke (.getDeclaredMethod enum "valueOf" (into-array [String]))

nil (into-array [value])))

(declare log-or-throw)

(defmacro defn-log-or-throw []

(try

(require 'clojure.tools.logging)

`(defn ~'log-or-throw [message#]

(clojure.tools.logging/info message#))

(catch Throwable _

`(defn ~'log-or-throw [message#]

(throw (new NoSuchFieldException message#))))))

(defn-log-or-throw)

(defn- throw-log-or-ignore-missing-setter [key ^Class clazz]

(let [message (str "Missing setter for " key " in " (.getCanonicalName clazz))]

(cond (= *to-java-object-missing-setter* :error)

(throw (new NoSuchFieldException message))

(= *to-java-object-missing-setter* :log)

(log-or-throw message))))

(comment

(binding [*to-java-object-missing-setter* :log]

(throw-log-or-ignore-missing-setter :foo String))

)

(defmacro ^{:private true} when-available

[sym & body]

(try

(when (resolve sym)

(list* 'do body))

(catch ClassNotFoundException _#)))

(defmacro ^{:private true} when-not-available

[sym & body]

(try

(when-not (resolve sym)

(list* 'do body))

(catch ClassNotFoundException _#)))

(when-available

java.time.Instant

(defmethod to-java [java.time.Instant clojure.lang.APersistentMap] [_ props]

(when-not (and (:nano props) (:epochSecond props))

(throw (IllegalArgumentException. "java.time.Instant requires :nano and :epochSecond")))

(java.time.Instant/ofEpochSecond (:epochSecond props) (:nano props))))

(defn- set-properties-on

"Given an instance, its class, and a hash map of properties,

[instance ^Class clazz props]

(let [setter-map (reduce add-setter-fn {} (get-property-descriptors clazz))]

(doseq [[key value] props]

(let [setter (get setter-map (keyword key))]

(if (nil? setter)

(throw-log-or-ignore-missing-setter key clazz)

(apply setter [instance value]))))

instance))

(defmethod to-java [java.util.Properties clojure.lang.APersistentMap]

[_ props]

(reduce-kv (fn [^java.util.Properties p k v]

(if (or (symbol? k) (keyword? k))

(.setProperty p (name k) (str v))

(.setProperty p (str k) (str v)))

p)

(java.util.Properties.)

props))

(defmethod to-java [Object clojure.lang.APersistentMap] [^Class clazz props]

(if (.isInterface clazz)

(if (instance? clazz props)

(condp = clazz

;; make a fresh (mutable) hash map from the Clojure map

java.util.Map (java.util.HashMap. ^java.util.Map props)

;; Iterable, Serializable, Runnable, Callable

;; we should probably figure out actual objects to create...

props)

(throw (IllegalArgumentException.

(str (.getName clazz) " is an interface "

"and cannot be constructed from "

(str/join ", " (map name (keys props)))))))

(let [ctr-args (::constructor (meta props))

ctr (when ctr-args (find-constructor clazz ctr-args))

instance (try

(if ctr

(.newInstance ctr (object-array ctr-args))

(.newInstance clazz))

(catch Throwable t

(throw (IllegalArgumentException.

(str (.getName clazz)

" cannot be constructed")

t))))]

(set-properties-on instance clazz props))))

(when-available

biginteger

(defmethod to-java [java.math.BigInteger Object] [_ value] (biginteger value)))

(when-not-available

biginteger

(defmethod to-java [java.math.BigInteger Object] [_ value] (bigint value)))

(defn set-properties

"Given an existing Java object and a Clojure map, use reflection to

[instance props]

(set-properties-on instance (class instance) props))

(defmethod from-java :default [^Object instance]

(let [clazz (.getClass instance)]

(if (.isArray clazz)

((:from (add-array-methods clazz)) instance)

(let [getter-map (reduce add-getter-fn {} (get-property-descriptors clazz))]

(into {} (for [[key getter-fn] (seq getter-map)] [key (getter-fn instance)]))))))

(defmethod from-java-deep :default [^Object instance opts]

(let [clazz (.getClass instance)]

(if (.isArray clazz)

((:from-deep (add-array-methods clazz)) instance opts)

(let [getter-map (reduce #(add-deep-getter-fn %1 %2 opts) {} (get-property-descriptors clazz))

exs (atom [])

pairs (for [[key getter-fn] (seq getter-map)

:when (not (contains? (:omit opts) key))

:let [[k v]

(if-let [exh (:exceptions opts)]

(try

[key (getter-fn instance)]

(catch Throwable t

(case exh

:group (swap! exs conj [key t])

:omit nil

:qualify [(keyword (name key)

"exception") t]

:return [key t])))

[key (getter-fn instance)])]

:when k]

[k v])]

(cond-> {}

(:add-class opts) (assoc :class (class instance))

(seq @exs) (assoc :exceptions (into {} @exs))

(seq pairs) (into pairs))))))

(defmethod from-java-shallow :default [^Object instance opts]

(let [clazz (.getClass instance)]

(if (.isArray clazz)

((:from-shallow (add-array-methods clazz)) instance opts)

(let [getter-map (reduce add-shallow-getter-fn {} (get-property-descriptors clazz))

exs (atom [])

pairs (for [[key getter-fn] (seq getter-map)

:when (not (contains? (:omit opts) key))

:let [[k v]

(if-let [exh (:exceptions opts)]

(try

[key (getter-fn instance)]

(catch Throwable t

(case exh

:group (swap! exs conj [key t])

:omit nil

:qualify [(keyword (name key)

"exception") t]

:return [key t])))

[key (getter-fn instance)])]

:when k]

[k v])]

(cond-> {}

(:add-class opts) (assoc :class (class instance))

(seq @exs) (assoc :exceptions (into {} @exs))

(seq pairs) (into pairs))))))

(doseq [clazz [String Character Byte Short Integer Long Float Double

java.math.BigInteger java.math.BigDecimal]]

(derive clazz ::do-not-convert))

(defmacro ^{:private true} defnumber [box prim prim-getter]

`(let [conv# (fn [_# ^Number number#]

(~(symbol (str box) "valueOf")

(. number# ~prim-getter)))]

(.addMethod ^clojure.lang.MultiFn to-java [~prim Number] conv#)

(.addMethod ^clojure.lang.MultiFn to-java [~box Number] conv#)))

(defmacro ^{:private true} defnumbers [& boxes]

(cons `do

(for [box boxes

:let [^Class box-cls (resolve box)

^Class prim-cls (.get (.getField box-cls "TYPE")

box-cls)

;; Clojure 1.3: (assert (class? box-cls) (str box ": no class found"))

_ (assert (class? box-cls))

;; Clojure 1.3: (assert (class? prim-cls) (str box " has no TYPE field"))

_ (assert (class? prim-cls))

prim-getter (symbol (str (.getName prim-cls) "Value"))]]

`(defnumber ~box ~(symbol (str box) "TYPE") ~prim-getter))))

(defnumbers Byte Short Integer Long Float Double)

(defmethod from-java ::do-not-convert [value] value)

(prefer-method from-java ::do-not-convert Object)

(defmethod from-java-deep ::do-not-convert [value _] value)

(prefer-method from-java-deep ::do-not-convert Object)

(defmethod from-java-shallow ::do-not-convert [value _] value)

(prefer-method from-java-shallow ::do-not-convert Object)

(defmethod from-java Iterable [instance]

(for [each (seq instance)] (from-java each)))

(prefer-method from-java Iterable Object)

(defmethod from-java-deep Iterable [instance opts]

(for [each (seq instance)] (from-java-deep each opts)))

(prefer-method from-java-deep Iterable Object)

(defmethod from-java-shallow Iterable [instance opts]

(for [each (seq instance)] (from-java-shallow each opts)))

(prefer-method from-java-shallow Iterable Object)

(defmethod from-java java.util.Map [instance] (into {} instance))

(prefer-method from-java java.util.Map Iterable)

(defmethod from-java-deep java.util.Map [instance opts]

(reduce (fn [m [k v]]

(assoc m (from-java-deep k opts) (from-java-deep v opts)))

{}

instance))

(prefer-method from-java-deep java.util.Map Iterable)

(defmethod from-java-shallow java.util.Map [instance _] (into {} instance))

(prefer-method from-java-shallow java.util.Map Iterable)

(defmethod from-java nil [_] nil)

(defmethod from-java java.sql.SQLException [^Object ex]

((get-method from-java :default) ex))

(defmethod from-java Boolean [value] (boolean value))

(defmethod from-java Enum [enum] (str enum))

(defmethod from-java-deep nil [_ _] nil)

(defmethod from-java-deep java.sql.SQLException [^Object ex opts]

((get-method from-java-deep :default) ex opts))

(defmethod from-java-deep Boolean [value _] (boolean value))

(defmethod from-java-deep Enum [enum _] (str enum))

(defmethod from-java-shallow nil [_ _] nil)

(defmethod from-java-shallow java.sql.SQLException [^Object ex opts]

((get-method from-java-shallow :default) ex opts))

(defmethod from-java-shallow Boolean [value _] (boolean value))

(defmethod from-java-shallow Enum [enum _] (str enum))

(defmethod to-java [javax.xml.datatype.XMLGregorianCalendar clojure.lang.APersistentMap] [^Class clazz props]

(let [^javax.xml.datatype.XMLGregorianCalendar instance (.newInstance clazz)

undefined javax.xml.datatype.DatatypeConstants/FIELD_UNDEFINED

getu #(get %1 %2 undefined)

y (getu props :year)]

;; .setYear is unique in having an overload on int and BigInteger

;; whereas the other setters only have an int version so avoiding

;; reflection means special treatment for .setYear

(if (instance? java.math.BigInteger y)

(.setYear instance ^java.math.BigInteger y)

(.setYear instance ^int y))

(doto instance

(.setMonth (getu props :month))

(.setDay (getu props :day))

(.setHour (getu props :hour))

(.setMinute (getu props :minute))

(.setSecond (getu props :second))

(.setTimezone (getu props :timezone)))))

(defn- from-xml-gregorian-calendar

"Turn an XMLGregorianCalendar object into a clojure map of year, month, day, hour, minute, second and timezone "

[^javax.xml.datatype.XMLGregorianCalendar obj]

(let [date {:year (.getYear obj)

:month (.getMonth obj)

:day (.getDay obj)}

time {:hour (.getHour obj)

:minute (.getMinute obj)

:second (.getSecond obj)}

tz {:timezone (.getTimezone obj)}

is-undefined? #(= javax.xml.datatype.DatatypeConstants/FIELD_UNDEFINED %1)]

(conj {}

(when-not (is-undefined? (:year date))

date)

(when-not (is-undefined? (:hour time))

time)

(when-not (is-undefined? (:timezone tz))

tz))))

(defmethod from-java javax.xml.datatype.XMLGregorianCalendar

[obj] (from-xml-gregorian-calendar obj))

(defmethod from-java-deep javax.xml.datatype.XMLGregorianCalendar

[obj {:keys [add-class]}]

(cond-> (from-xml-gregorian-calendar obj)

add-class (assoc :class (class obj))))

(defmethod from-java-shallow javax.xml.datatype.XMLGregorianCalendar

[obj {:keys [add-class]}]

(cond-> (from-xml-gregorian-calendar obj)

add-class (assoc :class (class obj))))