deftx_v2.clj

(defn- filtered-refers
  "ns-refers, but without clojure.core vars"
  [ns]
  (into {} (filter (fn [[_ v]] (not= "clojure.core" (namespace (symbol v))))
                   (ns-refers ns))))

(defn- fully-qualify-symbols
  "Add fully qualified symbols where needed so that we can store the body in an XTDB transaction function.
  "
  [body]
  (let [ns-vars (clojure.core/merge (ns-interns *ns*) (filtered-refers *ns*))]
    (walk/postwalk
      (fn [x]
        (cond
          (and (symbol? x) (some? (namespace x)))
          (symbol (ns-resolve *ns* x))

          (and (symbol? x) (contains? ns-vars x))
          (symbol (get ns-vars x))

          :else
          x))
      body)))

;; macro for transactions to avoid race conditions: https://clojurians-log.clojureverse.org/crux/2020-03-24
(defmacro deftx [name bindings & body]
  "Defines a function used for mutations that uses a Crux transaction function under the hood.
  Body must return a valid Crux transaction vector (or return false, error, etc.)
  `install-tx-fns` must be called on the node before the deftx function can work.

  NOTE: XTDB tx fns require all symbols to be fully qualified. This macro will attempt to resolve
  them for you, with the following restriction: none of your symbols should shadow either symbols
  that are interned in your current namespace, or ones that are :refer'd into your current namespace.

  (If you do shadow them, e.g. in a `let` expression, this macro will fully qualify them and likely
  produce an invalid expression which the compiler will complain about.)"
  (let [kwd-name (keyword (str *ns*) (str name))
        symbol-name (symbol (str name))
        fq-bindings (fully-qualify-symbols bindings)
        fq-body (fully-qualify-symbols body)]
    `(do
       (def
         ~(vary-meta
            symbol-name
            assoc
            :crux-tx-fn
            `(fn [node#]
               (xt/submit-tx node# [[:xtdb.api/put {:xt/id ~kwd-name
                                                    :xt/fn (quote (fn ~fq-bindings
                                                                    ~@fq-body))}]])))
         (fn ~symbol-name [node# & ~'args]
           (let [tx-map# (xt/submit-tx node# [(into [:xtdb.api/fn ~kwd-name] ~'args)])]
             (xt/await-tx node# tx-map#)
             (xt/tx-committed? node# tx-map#))))
       ;; Also define a version that just returns the transaction
       (def
         ~(symbol (str symbol-name "**"))
         (fn ~symbol-name [node# & ~'args]
           [(into [:xtdb.api/fn ~kwd-name] ~'args)]))))

(defn install-deftx-fns
  "Given a node and a seq of namespace symbols, scan all public vars
  and use any :crux-tx-fn in their metadata to install the tx-fn on
  the node"
  ([node]
   ;; If no namespaces are supplied, take all "my.xtdb.ns" nses that aren't tests
   (install-deftx-fns
     node
     (->> (all-ns)
          (filter #(clojure.string/starts-with? (str %) "my.xtdb.ns"))
          (filter #(not (clojure.string/ends-with? (str %) "-test"))))))
  ([node namespaces]
   (doseq [ns-symbol namespaces]
     (when-let [ns (the-ns ns-symbol)]
       (doseq [[vname v] (ns-publics ns)]
         (when-let [tx-install-fn (some-> v meta :crux-tx-fn)]
           ;; evict any already-existing entities with the tx-fn's id
           ;; TODO: is there any cost to doing this over and over? If so, consider
           ;; enabling this only in dev and using a put-if-nil strategy for prod
           (xt/await-tx node (xt/submit-tx node [[:xtdb.api/evict (keyword (str ns) (str vname))]]))
           (tx-install-fn node)))))))

;; Wherever you start your node, call install-deftx-fns on it: note you don't need to tell it anything special
(mount/defstate xtdb-node 
  :start 
  (let [node ...]
    (install-deftx-fns node))) 

;; Now, in your other namespace: use deftx to define a transaction function that 
;; can do whatever it wants, usually returning a transaction vector
(deftx my-function [xtdb-node arg1 arg2]
  (let [res1 (f arg1 arg2)]
    [[:xtdb.api/put res1]]))

;; Finally, in your consumer code, just use my-function as you would any other side-effecting fn:
(my-function xtdb-node :foo :bar)
;; Or, if you want to compose its contents into a larger transaction, use the ** suffixed version:
(let [new-tx (into existing-tx (my-function** xtdb-node :foo :bar))]
  ...)