Skip to content

Instantly share code, notes, and snippets.

@terjesb
Forked from jsnikeris/gist:3386949
Created August 18, 2012 16:52
Show Gist options
  • Save terjesb/3388327 to your computer and use it in GitHub Desktop.
Save terjesb/3388327 to your computer and use it in GitHub Desktop.
Macro for defining Datomic database functions
(require '[datomic.api :as d])
(defn maybe-assoc [m k v]
(if v (assoc m k v) m))
(defmacro defn-db [name & args]
(let [[doc-string & args] (if (string? (first args)) args (cons nil args))
[attr-map & args] (if (map? (first args)) args (cons {} args))
[[& params] & body] args
metadata (-> attr-map
(assoc :dbfn true)
(maybe-assoc :doc doc-string)
(dissoc :requires :imports))]
`(def ~(vary-meta name merge metadata)
(datomic.api/function {:lang "clojure"
:params '~params
:requires ~(:requires attr-map)
:imports ~(:imports attr-map)
:code '(do ~@body)}))))
(defn db-fns-tx [ns]
(for [var (vals (ns-interns ns)) :when (:dbfn (meta var))
:let [{:keys [name doc]} (meta var)]]
(-> {:db/id (d/tempid :db.part/user)
:db/ident (keyword name)
:db/fn (var-get var)}
(maybe-assoc :db/doc doc))))
;;; example
(defn-db validate-age
"Validates a person's age."
[age]
(assert (number? age))
(assert (> age 0)))
(defn-db construct-person
"Validates a person and returns it as tx data"
{:requires '[[datomic.api :as d]]}
[db person]
(let [validate-age (:db/fn (d/entity db :validate-age))]
(validate-age (:person/age person))
[(merge {:db/id (d/tempid :db.part/user)} person)]))
(def db-uri "datomic:mem://temp")
(def ^:dynamic *conn* nil)
(defmacro with-conn [& body]
`(binding [*conn* (d/connect db-uri)]
~@body))
(defn install-dbfns! []
(with-conn
(d/transact *conn* (db-fns-tx *ns*))))
(defn install-schema! []
(with-conn
(d/transact *conn*
[{:db/ident :person/name
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/id #db/id[:db.part/db]
:db.install/_attribute :db.part/db}
{:db/ident :person/age
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one
:db/id #db/id[:db.part/db]
:db.install/_attribute :db.part/db}])))
(defn init-db! []
(d/create-database db-uri)
(install-schema!)
(install-dbfns!))
(defn create-person! [person]
(with-conn
(d/transact *conn* [[:construct-person person]])))
(comment
(init-db!)
(create-person! {:person/name "Tom Sawyer"
:person/age 11})
(d/q '[:find ?n :where
[?p :person/age 11]
[?p :person/name ?n]]
(with-conn (d/db *conn*))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment