Utils for constructing datomic queries

query.clj

(ns utils.query
  (:require [datomic.api :refer [q]]))

(defn- in?
  [elm coll]
  (some #(= elm %) coll))

(defn qr
  "returns the first items of each tuple in `coll`"
  [coll]
  (reduce #(conj %1 (first %2)) [] coll))

(defn exec
  "execute a query in a peer-compatible way"
  [{:keys [query args]}]
  (apply q query args))

(defn exec-ff
  "execute a query and get the ffirst item"
  [q]
  (-> q exec ffirst))

(defn exec-qr
  "execute a query and get the first item of each tuple in result"
  [q]
  (-> q exec qr))

(defn id-by-ident-val
  [db ident value]
  (let [query '[:find ?e
                :in $ ?ident ?target
                :where [?e ?ident ?target]]]
    (ffirst (q query db ident value))))

(defn pull-by-ident-val
  ([db ident value] (pull-by-ident-val db ident value {}))
  ([db ident value {:keys [required-idents
                           pattern]
                    :or {required-idents []
                         pattern '[*]}}]
   (let [base-query       '[:find (pull ?e pattern)
                            :in $ pattern ?ident ?target
                            :where [?e ?ident ?target]]
         additional-where (map #(vector '?e % '_) required-idents)
         query            (into [] (concat base-query additional-where))]
     (ffirst (q query db pattern ident value)))))

(defn qj
  "joins two query maps"
  [original addition]
  (reduce-kv (fn [acc k v]
               (let [additions (->> v
                                    (remove #(in? % (k acc))))]
                 (assoc acc k (concat (acc k)
                                    additions))))
             original addition))

(defn qja
  "query join args, joins two query with args maps"
  [original addition]
  (let [joined-query (qj (:query original) (:query addition))
        joined-args (concat (:args original) (:args addition))]
    {:query joined-query
     :args joined-args}))

(defn qcond
  "add basic where clause to query"
  [q attr val]
  (let [attr-in (symbol (str "?munged" (munge attr)))]
    (qja q {:query {:in [attr-in]
                    :where [['?e attr attr-in]]}
            :args [val]})))

(defn args
  "add multiple arguments to query"
  ([args] (args {} args))
  ([q args]
   (assoc q :args (concat (:args q) args))))

(defn arg
  "add single argument to query"
  ([arg] (args {} [arg]))
  ([q arg] (args q [arg])))


(defn conj-into-query
  "conj an item into a query entry"
  [q k v]
  (assoc-in q [:query k] (conj (into [] (-> q :query k)) v)))

(defn in
  "add an in entry to query"
  ([val] (in {} val))
  ([q val]
   (conj-into-query q :in val)))

(defn where
  "add a where clause to a query"
  ([clause] (where {} clause))
  ([q clause]
   (conj-into-query q :where clause)))

(defn wheres
  "add multiple where clauses to a query"
  ([q & clauses]
   (reduce #(where %1 %2) q clauses)))

(defn add-find
  "add a find item to q query"
  ([find-stmt] (add-find {} find-stmt))
  ([q find-stmt]
   (conj-into-query q :find find-stmt)))

(defn add-finds
  "add multiple find items to a query"
  ([finds] (add-finds {} finds))
  ([q finds]
   (reduce #(add-find %1 %2) q finds)))

(defn add-key
  "add a key into a query"
  ([k] (add-key {} k))
  ([q k] (conj-into-query q :keys k)))

(defn add-keys
  "add multiple keys into a query"
  [q & ks]
  (reduce #(add-key %1 %2) q ks))

(defn kfind
  "add keys and a corresponding find into query"
  ([m] (kfind {} m))
  ([q m]
   (reduce-kv
    #(-> %1
         (add-key %2)
         (add-find %3))
    q m)))

(defn build-pull
  "construct a pull statement for symbols"
  [entity-symb pattern-symb]
  (-> '()
      (conj pattern-symb)
      (conj entity-symb)
      (conj 'pull)))


(defn find-pattern
  "add a pattern to the find clause with an arg and an in clause"
  ([pattern] (find-pattern {} '?e pattern))
  ([q-or-symb pattern] (if (symbol? q-or-symb)
                         (find-pattern {} q-or-symb pattern)
                         (find-pattern q-or-symb '?e pattern)))
  ([q entity-symb pattern]
   (find-pattern q entity-symb 'pattern pattern))
  ([q entity-symb pattern-symb pattern]
   (-> q
       (add-find (build-pull entity-symb pattern-symb))
       (arg pattern)
       (in pattern-symb))))



(defn in-args
  "adds an in clause with a correponding arg to query args map"
  ([m] (in-args {} m))
  ([q m]
   (reduce-kv (fn [a k v] (-> a
                             (in k)
                             (arg v)))
              q m)))

(defn db-arg
  "shorthand to add a db into args and in into a query"
  ([db] (db-arg {} db))
  ([q db] (in-args q {'$ db})))

(defn rules-arg
  "shorthand to add rules into args and in into a query"
  ([rules] (rules-arg {} rules))
  ([q rules] (in-args q {'% rules})))

(defn pred
  "join queries if pred value is truthy"
  ([predicate form] (pred {} predicate form))
  ([q predicate form]
   (if predicate
     (qja q form)
     q)))