(ns datascript.pull-api (:require [datascript.db :as db] [datascript.pull-parser :as dpp #?@(:cljs [:refer [PullSpec]])]) #?(:clj (:import [datascript.db Datom] [datascript.pull_parser PullSpec]))) (defn- into! [transient-coll items] (reduce conj! transient-coll items)) (def ^:private ^:const +default-limit+ 1000) (defn- initial-frame [pattern eids multi?] {:state :pattern :pattern pattern :wildcard? (:wildcard? pattern) :specs (-> pattern :attrs seq) :results (transient []) :kvps (transient {}) :eids eids :multi? multi? :recursion {:depth {} :seen #{}}}) (defn- subpattern-frame [pattern eids multi? attr] (assoc (initial-frame pattern eids multi?) :attr attr)) (defn- reset-frame [frame eids kvps] (let [pattern (:pattern frame)] (assoc frame :eids eids :specs (seq (:attrs pattern)) :wildcard? (:wildcard? pattern) :kvps (transient {}) :results (cond-> (:results frame) (seq kvps) (conj! kvps))))) (defn- push-recursion [rec attr eid] (let [{:keys [depth seen]} rec] (assoc rec :depth (update depth attr (fnil inc 0)) :seen (conj seen eid)))) (defn- seen-eid? [frame eid] (-> frame (get-in [:recursion :seen] #{}) (contains? eid))) (defn- pull-seen-eid [frame frames eid] (when (seen-eid? frame eid) (conj frames (update frame :results conj! {:db/id eid})))) (defn- single-frame-result [key frame] (some-> (:kvps frame) persistent! (get key))) (defn- recursion-result [frame] (single-frame-result ::recursion frame)) (defn- recursion-frame [parent eid] (let [attr (:attr parent) rec (push-recursion (:recursion parent) attr eid)] (assoc (subpattern-frame (:pattern parent) [eid] false ::recursion) :recursion rec))) (defn- pull-recursion-frame [db [frame & frames]] (if-let [eids (seq (:eids frame))] (let [frame (reset-frame frame (rest eids) (recursion-result frame)) eid (first eids)] (or (pull-seen-eid frame frames eid) (conj frames frame (recursion-frame frame eid)))) (let [kvps (recursion-result frame) results (cond-> (:results frame) (seq kvps) (conj! kvps))] (conj frames (assoc frame :state :done :results results))))) (defn- recurse-attr [db attr multi? eids eid parent frames] (let [{:keys [recursion pattern]} parent depth (-> recursion (get :depth) (get attr 0))] (if (-> pattern :attrs (get attr) :recursion (= depth)) (conj frames parent) (pull-recursion-frame db (conj frames parent {:state :recursion :pattern pattern :attr attr :multi? multi? :eids eids :recursion recursion :results (transient [])}))))) (let [pattern (PullSpec. true {})] (defn- expand-frame [parent eid attr-key multi? eids] (let [rec (push-recursion (:recursion parent) attr-key eid)] (-> pattern (subpattern-frame eids multi? attr-key) (assoc :recursion rec))))) (defn- pull-attr-datoms [db attr-key attr eid forward? datoms opts [parent & frames]] (let [limit (get opts :limit +default-limit+) found (not-empty (cond->> datoms limit (into [] (take limit))))] (if found (let [ref? (db/ref? db attr) component? (and ref? (db/component? db attr)) multi? (if forward? (db/multival? db attr) (not component?)) datom-val (if forward? (fn [^Datom d] (.-v d)) (fn [^Datom d] (.-e d)))] (cond (contains? opts :subpattern) (->> (subpattern-frame (:subpattern opts) (mapv datom-val found) multi? attr-key) (conj frames parent)) (contains? opts :recursion) (recurse-attr db attr-key multi? (mapv datom-val found) eid parent frames) (and component? forward?) (->> found (mapv datom-val) (expand-frame parent eid attr-key multi?) (conj frames parent)) :else (let [as-value (cond->> datom-val ref? (comp #(hash-map :db/id %))) single? (not multi?)] (->> (cond-> (into [] (map as-value) found) single? first) (update parent :kvps assoc! attr-key) (conj frames))))) (->> (cond-> parent (contains? opts :default) (update :kvps assoc! attr-key (:default opts))) (conj frames))))) (defn- pull-attr [db spec eid frames] (let [[attr-key opts] spec] (if (= :db/id attr-key) (if (not-empty (db/-datoms db :eavt [eid])) (conj (rest frames) (update (first frames) :kvps assoc! :db/id eid)) frames) (let [attr (:attr opts) forward? (= attr-key attr) results (if forward? (db/-datoms db :eavt [eid attr]) (db/-datoms db :avet [attr eid]))] (pull-attr-datoms db attr-key attr eid forward? results opts frames))))) (def ^:private filter-reverse-attrs (filter (fn [[k v]] (not= k (:attr v))))) (defn- expand-reverse-subpattern-frame [parent eid rattrs] (-> (:pattern parent) (assoc :attrs rattrs :wildcard? false) (subpattern-frame [eid] false ::expand-rev))) (defn- expand-result [frames kvps] (->> kvps (persistent!) (update (first frames) :kvps into!) (conj (rest frames)))) (defn- pull-expand-reverse-frame [db [frame & frames]] (->> (or (single-frame-result ::expand-rev frame) {}) (into! (:expand-kvps frame)) (expand-result frames))) (defn- pull-expand-frame [db [frame & frames]] (if-let [datoms-by-attr (seq (:datoms frame))] (let [[attr datoms] (first datoms-by-attr) opts (-> frame (get-in [:pattern :attrs]) (get attr {}))] (pull-attr-datoms db attr attr (:eid frame) true datoms opts (conj frames (update frame :datoms rest)))) (if-let [rattrs (->> (get-in frame [:pattern :attrs]) (into {} filter-reverse-attrs) not-empty)] (let [frame (assoc frame :state :expand-rev :expand-kvps (:kvps frame) :kvps (transient {}))] (->> rattrs (expand-reverse-subpattern-frame frame (:eid frame)) (conj frames frame))) (expand-result frames (:kvps frame))))) (defn- pull-wildcard-expand [db frame frames eid pattern] (let [datoms (group-by (fn [^Datom d] (.-a d)) (db/-datoms db :eavt [eid])) {:keys [attr recursion]} frame rec (cond-> recursion (some? attr) (push-recursion attr eid))] (->> {:state :expand :kvps (transient {:db/id eid}) :eid eid :pattern pattern :datoms (seq datoms) :recursion rec} (conj frames frame) (pull-expand-frame db)))) (defn- pull-wildcard [db frame frames] (let [{:keys [eid pattern]} frame] (or (pull-seen-eid frame frames eid) (pull-wildcard-expand db frame frames eid pattern)))) (defn- pull-pattern-frame [db [frame & frames]] (if-let [eids (seq (:eids frame))] (if (:wildcard? frame) (pull-wildcard db (assoc frame :specs [] :eid (first eids) :wildcard? false) frames) (if-let [specs (seq (:specs frame))] (let [spec (first specs) pattern (:pattern frame) new-frames (conj frames (assoc frame :specs (rest specs)))] (pull-attr db spec (first eids) new-frames)) (->> frame :kvps persistent! not-empty (reset-frame frame (rest eids)) (conj frames) (recur db)))) (conj frames (assoc frame :state :done)))) (defn- pull-pattern [db frames] (case (:state (first frames)) :expand (recur db (pull-expand-frame db frames)) :expand-rev (recur db (pull-expand-reverse-frame db frames)) :pattern (recur db (pull-pattern-frame db frames)) :recursion (recur db (pull-recursion-frame db frames)) :done (let [[f & remaining] frames result (cond-> (persistent! (:results f)) (not (:multi? f)) first)] (if (seq remaining) (->> (cond-> (first remaining) result (update :kvps assoc! (:attr f) result)) (conj (rest remaining)) (recur db)) result)))) (defn pull-spec [db pattern eids multi?] (let [eids (into [] (map #(db/entid-strict db %)) eids)] (pull-pattern db (list (initial-frame pattern eids multi?))))) (defn pull [db selector eid] {:pre [(db/db? db)]} (pull-spec db (dpp/parse-pull selector) [eid] false)) (defn pull-many [db selector eids] {:pre [(db/db? db)]} (pull-spec db (dpp/parse-pull selector) eids true))