(ns frontend.db.query-dsl (:require [cljs-time.coerce :as tc] [cljs-time.core :as t] [cljs.reader :as reader] [clojure.core] [clojure.set :as set] [clojure.string :as string] [clojure.walk :as walk] [frontend.date :as date] [frontend.db.model :as model] [frontend.db.query-react :as react] [frontend.db.utils :as db-utils] [frontend.template :as template] [frontend.text :as text] [frontend.util :as util] [frontend.state :as state] [frontend.util.property :as property] [lambdaisland.glogi :as log])) ;; Query fields: ;; and ;; or ;; not ;; between ;; Example: (between -7d +7d) ;; (between created-at -1d today) ;; (between last-modified-at -1d today) ;; [[page-ref]] ;; property (block) ;; task (block) ;; priority (block) ;; page ;; page-property (page) ;; page-tags (page) ;; all-page-tags ;; project (block, TBD) ;; Sort by (field, asc/desc): ;; created_at ;; last_modified_at ;; (sort-by last_modified_at asc) (defonce remove-nil? (partial remove nil?)) (defn query-wrapper [where blocks?] (when where (let [q (if blocks? ; FIXME: it doesn't need to be either blocks or pages `[:find (~'pull ~'?b ~model/block-attrs) :where] '[:find (pull ?p [*]) :where]) result (if (coll? (first where)) (apply conj q where) (conj q where))] (prn "Datascript query: " result) result))) ;; (between -7d +7d) (defn- ->journal-day-int [input] (let [input (string/lower-case (name input))] (cond (= "today" input) (db-utils/date->int (t/today)) (= "yesterday" input) (db-utils/date->int (t/yesterday)) (= "tomorrow" input) (db-utils/date->int (t/plus (t/today) (t/days 1))) (text/page-ref? input) (let [input (-> (text/page-ref-un-brackets! input) (string/replace ":" "") (string/capitalize))] (when (date/valid-journal-title? input) (date/journal-title->int input))) :else (let [duration (util/parse-int (subs input 0 (dec (count input)))) kind (last input) tf (case kind "y" t/years "m" t/months "w" t/weeks t/days)] (db-utils/date->int (t/plus (t/today) (tf duration))))))) (defn- ->timestamp [input] (let [input (string/lower-case (name input))] (cond (= "now" input) (util/time-ms) (= "today" input) (tc/to-long (t/today)) (= "yesterday" input) (tc/to-long (t/yesterday)) (= "tomorrow" input) (tc/to-long (t/plus (t/today) (t/days 1))) (text/page-ref? input) (let [input (-> (text/page-ref-un-brackets! input) (string/replace ":" "") (string/capitalize))] (when (date/valid-journal-title? input) (date/journal-title->long input))) :else (let [duration (util/parse-int (subs input 0 (dec (count input)))) kind (last input) tf (case kind "y" t/years "m" t/months "w" t/weeks "h" t/hours "n" t/minutes ; min t/days)] (tc/to-long (t/plus (t/today) (tf duration))))))) (defn uniq-symbol [counter prefix] (let [result (symbol (str prefix (when-not (zero? @counter) @counter)))] (swap! counter inc) result)) (defn- collect-vars [l] (let [vars (atom #{})] (walk/postwalk (fn [f] (when (and (symbol? f) (= \? (first (name f)))) (swap! vars conj f)) f) l) @vars)) (defn build-query ([repo e env] (build-query repo e (assoc env :vars (atom {})) 0)) ([repo e {:keys [sort-by blocks? sample counter current-filter vars] :as env} level] ;; TODO: replace with multi-methods for extensibility. (let [fe (first e) fe (when fe (symbol (string/lower-case (name fe)))) page-ref? (text/page-ref? e)] (when (or (and page-ref? (not (contains? #{'page-property 'page-tags} (:current-filter env)))) (contains? #{'between 'property 'todo 'task 'priority 'sort-by 'page} fe)) (reset! blocks? true)) (cond (nil? e) nil page-ref? (let [page-name (-> (text/page-ref-un-brackets! e) (util/page-name-sanity-lc))] [['?b :block/path-refs [:block/name page-name]]]) (string? e) ; block content full-text search, could be slow (do (reset! blocks? true) [['?b :block/content '?content] [(list 'clojure.string/includes? '?content e)]]) (contains? #{'and 'or 'not} fe) (let [clauses (->> (map (fn [form] (build-query repo form (assoc env :current-filter fe) (inc level))) (rest e)) remove-nil? (distinct)) nested-and? (and (= fe 'and) (= current-filter 'and))] (when (seq clauses) (let [result (cond (= fe 'not) (let [clauses (if (coll? (first clauses)) (apply concat clauses) clauses) clauses (if (and (= 1 (count clauses)) (= 'and (ffirst clauses))) ;; unflatten (rest (first clauses)) clauses)] (cons fe (seq clauses))) (coll? (first clauses)) (cond (= current-filter 'not) (->> (apply concat clauses) (apply list fe)) (or (= current-filter 'or) nested-and?) (apply concat clauses) :else (->> (map (fn [result] (let [result (if (vector? (ffirst result)) (apply concat result) result)] (cons 'and (seq result)))) clauses) (apply list fe))) :else (apply list fe clauses)) vars' (set/union (set @vars) (collect-vars result))] (reset! vars vars') (cond ;; TODO: more thoughts (and (= current-filter 'and) (= 'or fe) (= #{'?b} vars')) [(concat result [['?b]])] nested-and? result (and (zero? level) (= 'and fe)) (distinct (apply concat clauses)) (and (zero? level) (= 'or fe)) result :else [result])))) (and (= 'between fe) (= 3 (count e))) (let [start (->journal-day-int (nth e 1)) end (->journal-day-int (nth e 2)) [start end] (sort [start end])] [['?b :block/page '?p] ['?p :block/journal? true] ['?p :block/journal-day '?d] [(list '>= '?d start)] [(list '<= '?d end)]]) ;; (between created_at -1d today) (and (= 'between fe) (= 4 (count e))) (let [k (-> (second e) (name) (string/lower-case) (string/replace "-" "_"))] (when (contains? #{"created_at" "last_modified_at"} k) (let [start (->timestamp (nth e 2)) end (->timestamp (nth e 3))] (when (and start end) (let [[start end] (sort [start end]) sym '?v] [['?b :block/properties '?prop] [(list 'get '?prop k) sym] [(list '>= sym start)] [(list '< sym end)]]))))) (and (= 'property fe) (= 3 (count e))) (let [k (string/replace (name (nth e 1)) "_" "-") v (nth e 2) v (if-not (nil? v) (property/parse-property k v) v) v (if (coll? v) (first v) v) sym (if (= current-filter 'or) '?v (uniq-symbol counter "?v"))] [['?b :block/properties '?prop] [(list 'missing? '$ '?b :block/name)] [(list 'get '?prop (keyword k)) sym] (list 'or [(list '= sym v)] [(list 'contains? sym v)])]) (and (= 'property fe) (= 2 (count e))) (let [k (string/replace (name (nth e 1)) "_" "-")] [['?b :block/properties '?prop] [(list 'missing? '$ '?b :block/name)] [(list 'get '?prop (keyword k)) '?prop-v] [true]]) (or (= 'todo fe) (= 'task fe)) (let [markers (if (coll? (first (rest e))) (first (rest e)) (rest e))] (when (seq markers) (let [markers (set (map (comp string/upper-case name) markers))] [['?b :block/marker '?marker] [(list 'contains? markers '?marker)]]))) (= 'priority fe) (let [priorities (if (coll? (first (rest e))) (first (rest e)) (rest e))] (when (seq priorities) (let [priorities (set (map (comp string/upper-case name) priorities))] [['?b :block/priority '?priority] [(list 'contains? priorities '?priority)]]))) (= 'sort-by fe) (let [[k order] (rest e) order (if (and order (contains? #{:asc :desc} (keyword (string/lower-case (name order))))) (keyword (string/lower-case (name order))) :desc) k (-> (string/lower-case (name k)) (string/replace "_" "-")) get-value (cond (= k "created-at") :block/created-at (= k "updated-at") :block/updated-at :else #(get-in % [:block/properties k])) comp (if (= order :desc) >= <=)] (reset! sort-by (fn [result] (->> result flatten (clojure.core/sort-by get-value comp)))) nil) (= 'page fe) (let [page-name (text/page-ref-un-brackets! (str (first (rest e)))) page-name (util/page-name-sanity-lc page-name)] [['?b :block/page [:block/name page-name]]]) (and (= 'namespace fe) (= 2 (count e))) (let [page-name (text/page-ref-un-brackets! (str (first (rest e)))) page (util/page-name-sanity-lc page-name)] (when-not (string/blank? page) [['?p :block/namespace '?parent] ['?parent :block/name page]])) (= 'page-property fe) (let [[k v] (rest e) k (string/replace (name k) "_" "-")] (if-not (nil? v) (let [v (property/parse-property k v) v (if (coll? v) (first v) v) sym '?v] [['?p :block/name] ['?p :block/properties '?prop] [(list 'get '?prop (keyword k)) sym] (list 'or [(list '= sym v)] [(list 'contains? sym v)])]) [['?p :block/name] ['?p :block/properties '?prop] [(list 'get '?prop (keyword k)) '?prop-v] [true]])) (= 'page-tags fe) (let [tags (if (coll? (first (rest e))) (first (rest e)) (rest e)) tags (map (comp string/lower-case name) tags)] (when (seq tags) (let [tags (set (map (comp text/page-ref-un-brackets! string/lower-case name) tags)) sym-1 (uniq-symbol counter "?t") sym-2 (uniq-symbol counter "?tag")] [['?p :block/tags sym-1] [sym-1 :block/name sym-2] [(list 'contains? tags sym-2)]]))) (= 'all-page-tags fe) [['?e :block/tags '?p]] (= 'sample fe) (when-let [num (second e)] (when (integer? num) (reset! sample num)) nil) :else nil)))) (defn- pre-transform [s] (some-> s (string/replace text/page-ref-re "\"[[$1]]\"") (string/replace text/between-re (fn [[_ x]] (->> (string/split x #" ") (remove string/blank?) (map (fn [x] (if (or (contains? #{"+" "-"} (first x)) (and (util/safe-re-find #"\d" (first x)) (some #(string/ends-with? x %) ["y" "m" "d" "h" "min"]))) (keyword (name x)) x))) (string/join " ") (util/format "(between %s)")))))) (defn- add-bindings! [form q] (let [forms (set (flatten q)) syms ['?b '?p 'not] [b? p? not?] (-> (set/intersection (set syms) forms) (map syms)) or? (contains? (set (flatten form)) 'or)] (cond not? (cond (and b? p?) (concat [['?b :block/uuid] ['?p :block/name] ['?b :block/page '?p]] q) b? (concat [['?b :block/uuid]] q) p? (concat [['?p :block/name]] q) :else q) or? (cond (->> (flatten form) (remove text/page-ref?) (some string?)) ; block full-text search (concat [['?b :block/content '?content]] [q]) :else q) (and b? p?) (concat [['?b :block/page '?p]] q) :else q))) (defn parse [repo s] (when (and (string? s) (not (string/blank? s))) (let [counter (atom 0)] (try (let [s (if (= \# (first s)) (util/format "[[%s]]" (subs s 1)) s) form (some-> s (pre-transform) (reader/read-string))] (if (symbol? form) (str form) (let [sort-by (atom nil) blocks? (atom nil) sample (atom nil) result (when form (build-query repo form {:sort-by sort-by :blocks? blocks? :counter counter :sample sample}))] (cond (and (nil? result) (string? form)) form (string? result) result :else (let [result (when (seq result) (let [key (if (coll? (first result)) (keyword (ffirst result)) (keyword (first result))) result (case key :and (rest result) result)] (add-bindings! form result)))] {:query result :sort-by @sort-by :blocks? (boolean @blocks?) :sample sample}))))) (catch js/Error e (log/error :query-dsl/parse-error e)))))) (defn query ([query-string] (query (state/get-current-repo) query-string)) ([repo query-string] (when (string? query-string) (let [query-string (template/resolve-dynamic-template! query-string)] (when-not (string/blank? query-string) (let [{:keys [query sort-by blocks? sample] :as result} (parse repo query-string) query (if (string? query) (string/trim query) query) full-text-query? (and (string? result) (not (string/includes? result " ")))] (if full-text-query? (if (= "\"" (first result) (last result)) (subs result 1 (dec (count result))) result) (when-let [query (query-wrapper query blocks?)] (let [sort-by (or sort-by identity) random-samples (if @sample (fn [col] (take @sample (shuffle col))) identity) transform-fn (comp sort-by random-samples)] (react/react-query repo {:query query :query-string query-string} {:use-cache? false :transform-fn transform-fn})))))))))) (defn custom-query [repo query-m query-opts] (when (seq (:query query-m)) (let [query-string (pr-str (:query query-m)) query-string (template/resolve-dynamic-template! query-string) {:keys [query sort-by blocks?]} (parse repo query-string) query (if (string? query) (string/trim query) query)] (when query (when-let [query (query-wrapper query blocks?)] (react/react-query repo (merge query-m {:query query}) (merge query-opts (when sort-by {:transform-fn sort-by})))))))) (comment ;; {{query (and (page-property foo bar) [[hello]])}} (query "(and [[foo]] [[bar]])") (query "(or [[foo]] [[bar]])") (query "(not (or [[foo]] [[bar]]))") (query "(between -7d +7d)") (query "(between -7d today)") (query "(between created_at yesterday today)") (query "(and [[some page]] (property foo bar))") (query "(and [[some page]] (task now later))") (query "(and [[some page]] (priority A))") ;; nested query (query "(and [[baz]] (or [[foo]] [[bar]]))") (query "(and [[some page]] (sort-by created-at))") (query "(and (page-property foo bar) [[hello]])"))