Skip to content

Instantly share code, notes, and snippets.

@hiredman
Created December 1, 2011 00:57
Show Gist options
  • Save hiredman/1412387 to your computer and use it in GitHub Desktop.
Save hiredman/1412387 to your computer and use it in GitHub Desktop.
defbean
(ns pharoh.core
(:import #_(org.drools.compiler DrlParser)
#_(org.drools.spi Consequence)
(java.beans PropertyChangeSupport)))
(definterface IBean
(init [])
(addPropertyChangeListener [pcl])
(removePropertyChangeListener [pcl]))
(defn camel-case [sym]
(let [[f & r] (.split (name sym) "-")]
(->> r
(mapcat (fn [[f & r]]
(cons (Character/toUpperCase f) r)))
(concat (seq f))
(apply str))))
(defmacro defbean [bean-name fields & details]
(let [prop (gensym 'prop)
ifacename (symbol (str "I" bean-name))]
(doseq [f fields]
(prn f (meta f)))
`(do
(definterface ~ifacename
~@(for [field fields]
`(~(with-meta (symbol (camel-case (str "get-" field)))
(meta field)) []))
~@(for [field fields
:when (:volatile-mutable (meta field))]
`(~(with-meta (symbol (camel-case (str "set-" field)))
{:tag 'void})
[~(with-meta (gensym 'a)
(meta field))])))
(deftype ~bean-name ~(vec (concat fields
[(with-meta prop
{:volatile-mutable true})]))
~@details
~ifacename
~@(for [field fields]
`(~(symbol (camel-case (str "get-" field)))
[~(gensym 'this)] ~(vary-meta field dissoc :tag)))
~@(for [field fields
:when (:volatile-mutable (meta field))
:let [arg-name (gensym 'a)]]
`(~(symbol (camel-case (str "set-" field)))
[~(gensym 'this) ~arg-name]
(let [old-value# ~(vary-meta field dissoc :tag)]
(set! ~(vary-meta field dissoc :tag) ~arg-name)
(.firePropertyChange ~prop ~(name field) old-value#
~arg-name))))
IBean
(init [p#]
(when-not ~prop
(set! ~prop (PropertyChangeSupport. p#))))
(addPropertyChangeListener [p# pcl#]
(.add ~prop pcl#))
(removePropertyChangeListener [p# pcl#]
(.remove ~prop pcl#)))
(defn ~(with-meta (symbol (.toLowerCase (name bean-name)))
{:tag ifacename
::backing-class bean-name})
[& {:keys ~(vec (for [f fields] (vary-meta f dissoc :tag)))}]
(doto (new ~bean-name ~@fields nil)
.init)))))
(defbean Person [^String ^:volatile-mutable name
^long ^:volatile-mutable age]
Object
(toString [p]
(str {:name name :age age}))
(equals [p o]
(and (instance? IPerson o)
(= (.getName p) (.getName o))
(= (.getAge p) (.getAge o))))
(hashCode [p]
(int (mod (+ (.hashCode name)
(.hashCode age))
Integer/MAX_VALUE))))
(def a-person (person :name "Some Guy" :age 1))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment