datascript query macros

query.clj

(require '[clojure.spec :as spec]
         '[clojure.walk :refer [prewalk]])

;; == Attempt 1
;; Unfortunately entagled with 'reduce':

(defmacro reduce-query [& args]
  (let [m (spec/conform
           (spec/cat :q (spec/spec
                         (spec/cat :q #(= :q %)
                                   :query identity
                                   :qargs (spec/* identity)))
                     :fn (spec/spec
                          (spec/cat :fn #(= :fn %)
                                    :args (spec/spec
                                           (spec/cat
                                            :acc identity
                                            :dqargs (spec/coll-of symbol?
                                                                  :kind vector?
                                                                  :distinct true)))
                                    :body (spec/* identity)))
                     :init (spec/spec
                            (spec/cat :init #(= :init %)
                                      :val identity)))
           args)]
    `(reduce
      (fn [~(-> m :fn :args :acc)
           ~(-> m :fn :args :dqargs)]
        ~@(-> m :fn :body))
      ~(-> m :init :val)
      (d/q (concat [:find]
                   '~(-> m :fn :args :dqargs)
                   ~(-> m :q :query))
           ~@(-> m :q :qargs)))))

;; example usages of attempt 1:
(reduce-query
 (:q '[:in $
       :where [?a :tree/child ?b]]
     db)
 (:fn [m [?a ?b]]
      (update m ?a (fnil conj #{}) ?b))
 (:init {}))


;;== Attempt 2
;; Is this just a poorly-tested symbol-macrolet?

(defmacro let-sym [bindings & body]
  (let [replacements (apply hash-map bindings)]
    `(do ~@(prewalk
            (fn [x]
              (let [s (spec/conform
                       (spec/*
                        (spec/cat
                         :pre (spec/* identity)
                         :unq (spec/spec
                               (spec/cat
                                :type #{`unquote `unquote-splicing}
                                :sym symbol?))
                         :suf (spec/* identity)))
                       x)]
                (if (= ::spec/invalid s)
                  x
                  (into (empty x)
                        (mapcat (fn [{:keys [pre unq suf]}]
                                  (let [v (get replacements (:sym unq))
                                        wv (if (= `unquote (:type unq))
                                             [v]
                                             v)]
                                    (concat pre wv suf))))
                        s))))
            body))))

;; example usage of attempt 2:
(let-sym [qa [?a ?b]]
  (->> (d/q '[:find ~@qa
              :in $
              :where [?a :tree/child ?b]]
            db)
       (reduce (fn [m ~qa]
                 (update m ?a (fnil conj #{}) ?b))
               {})))