Synapse/src/main/frontend/worker/query_dsl.cljs

(ns frontend.worker.query-dsl
  "Handles executing dsl queries a.k.a. simple queries"
  (:require ["chrono-node" :as chrono]
            [cljs-time.coerce :as tc]
            [cljs-time.core :as t]
            [cljs-time.format :as tf]
            [cljs.reader :as reader]
            [clojure.set :as set]
            [clojure.string :as string]
            [clojure.walk :as walk]
            [datascript.core :as d]
            [goog.object :as gobj]
            [logseq.common.date :as common-date]
            [logseq.common.util :as common-util]
            [logseq.common.util.date-time :as date-time-util]
            [logseq.common.util.page-ref :as page-ref]
            [logseq.db :as ldb]
            [logseq.db.frontend.class :as db-class]
            [logseq.db.frontend.query-dsl :as shared-query-dsl]
            [logseq.db.frontend.rules :as rules]))

;; Query fields:

;; Operators:
;; and
;; or
;; not

;; Filters:
;; between
;;   Example: (between -7d +7d)
;;            (between created-at -1d today)
;;            (between updated-at -1d today)
;; [[page-ref]]
;; property (block)
;; task (block)
;; priority (block)
;; page
;; sample
;; full-text-search ""

;; Time helpers
;; ============
(def ^:private journal-title-formatters
  (common-date/journal-title-formatters nil))

(defn- valid-journal-title?
  [title]
  (common-date/valid-journal-title? title nil))

(defn- journal-title->int
  [title]
  (date-time-util/journal-title->int title journal-title-formatters))

(defn- journal-title->long
  [title]
  (date-time-util/journal-title-> title tc/to-long journal-title-formatters))

(def ^:private template-re #"<%([^%].*?)%>")

(def ^:private journal-title-formatter
  (tf/formatter date-time-util/default-journal-title-formatter))

(defn- journal-name
  [date-time]
  (tf/unparse journal-title-formatter date-time))

(defn- nld-parse
  [s]
  (when (string? s)
    ((gobj/get chrono "parseDate") s)))

(defn- current-time
  []
  (tf/unparse (tf/formatter "h:mm a") (t/now)))

(defn- variable-rules
  [{:keys [current-page-title today-day]}]
  (let [today-date (if today-day
                     (tc/from-long
                      (date-time-util/journal-day->ms today-day))
                     (t/today))
        today (journal-name today-date)]
    {"today" (page-ref/->page-ref today)
     "yesterday" (page-ref/->page-ref
                  (journal-name (t/minus today-date (t/days 1))))
     "tomorrow" (page-ref/->page-ref
                 (journal-name (t/plus today-date (t/days 1))))
     "time" (current-time)
     "current page" (page-ref/->page-ref (or current-page-title today))}))

(defn- resolve-dynamic-template
  [content opts]
  (let [rules (delay (variable-rules opts))]
    (string/replace content template-re
                    (fn [[_ match]]
                      (let [match (string/trim match)
                            match-key (string/lower-case match)]
                        (cond
                          (string/blank? match)
                          ""

                          (contains? @rules match-key)
                          (get @rules match-key)

                          :else
                          (if-let [parsed (nld-parse match)]
                            (page-ref/->page-ref
                             (journal-name (tc/from-date parsed)))
                            match)))))))

(defn- ->journal-day-int [input]
  (let [input (string/lower-case (name input))]
    (cond
      (= "today" input)
      (date-time-util/date->int (t/today))

      (= "yesterday" input)
      (date-time-util/date->int (t/yesterday))

      (= "tomorrow" input)
      (date-time-util/date->int (t/plus (t/today) (t/days 1)))

      (page-ref/page-ref? input)
      (let [input (-> (page-ref/get-page-name input)
                      (string/replace ":" "")
                      (string/capitalize))]
        (when (valid-journal-title? input)
          (journal-title->int input)))

      :else
      (let [duration (parse-long (subs input 0 (dec (count input))))
            kind (last input)
            tf (case kind
                 "y" t/years
                 "m" t/months
                 "w" t/weeks
                 t/days)]
        (date-time-util/date->int (t/plus (t/today) (tf duration)))))))

(defn- ->timestamp [input]
  (let [input (string/lower-case (name input))]
    (cond
      (= "now" input)
      (common-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)))

      (page-ref/page-ref? input)
      (let [input (-> (page-ref/get-page-name input)
                      (string/replace ":" "")
                      (string/capitalize))]
        (when (valid-journal-title? input)
          (journal-title->long input)))

      :else
      (let [duration (parse-long (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/now) (tf duration)))))))

;; Boolean operator utils: and, or, not
;; ======================
(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-and-or-not-result
  [fe clauses current-filter nested-and?]
  (cond
    (= fe 'not)
    (if (every? list? clauses)
      (cons fe (seq clauses))
      (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)
      (cons 'and clauses)

      (or (= current-filter 'or)
          nested-and?)
      (cons 'and clauses)

      :else
      (->> clauses
           (mapcat (fn [result]
                     (cond
                       ;; rule like (task ?b #{"NOW"})
                       (list? result)
                       [result]
                       ;; datalog clause like [[?b :block/uuid]]
                       (vector? result)
                       result
                       :else
                       [(cons 'and (seq result))])))
           (apply list fe)))

    :else
    (apply list fe clauses)))

(declare build-query)

(defonce remove-nil? (partial remove nil?))

(defn- not-clause? [c]
  (and (seq? c) (= 'not (first c))))

(defn- distinct-preserve-order [xs]
  (let [seen (volatile! #{})]
    (reduce (fn [acc x]
              (if (contains? @seen x)
                acc
                (do (vswap! seen conj x)
                    (conj acc x))))
            [] xs)))

(defn- build-and-or-not
  [e {:keys [current-filter vars] :as env} level fe]
  (let [raw-clauses (map (fn [form]
                           (build-query form (assoc env :current-filter fe) (inc level)))
                         (rest e))

        ;; preserve order (no hash-order surprises)
        clauses (->> raw-clauses
                     (map :query)
                     remove-nil?
                     (distinct-preserve-order))

        ;; for (and ...), ensure any (not ...) comes AFTER positive binders
        clauses (if (= fe 'and)
                  (let [[nots others] (reduce (fn [[ns os] c]
                                                (if (not-clause? c)
                                                  [(conj ns c) os]
                                                  [ns (conj os c)]))
                                              [[] []]
                                              clauses)]
                    (concat others nots))
                  clauses)

        nested-and? (and (= fe 'and) (= current-filter 'and))]

    (when (seq clauses)
      (let [result (build-and-or-not-result fe clauses current-filter nested-and?)
            vars'  (set/union (set @vars) (collect-vars result))
            query  (cond
                     nested-and? result
                     (and (zero? level) (contains? #{'and 'or} fe)) result
                     (and (= 'not fe) (some? current-filter)) result
                     :else [result])]
        (reset! vars vars')
        {:query query
         :rules (distinct (mapcat :rules raw-clauses))}))))

;; build-query fns
;; ===============

;; Current DB when query is run
(def ^:dynamic *current-db*
  nil)

(def get-timestamp-property shared-query-dsl/get-timestamp-property)

(defn- build-journal-between-two-arg
  [e]
  (let [start (->journal-day-int (nth e 1))
        end (->journal-day-int (nth e 2))
        [start end] (sort [start end])]
    {:query (list 'between '?b start end)
     :rules [:between]}))

(defn- db-based-build-between-three-arg
  [e]
  (when-let [k (get-timestamp-property e)]
    (let [start (->timestamp (nth e 2))
          end (->timestamp (nth e 3))]
      (when (and start end)
        (let [[start end] (sort [start end])
              sym '?v]
          {:query [['?b k sym]
                   [(list '>= sym start)]
                   [(list '< sym end)]]})))))

(defn- db-based-build-between-two-arg
  [e]
  (db-based-build-between-three-arg (concat e ['now])))

(defn- build-between
  [e]
  (cond
    (= 3 (count e))
    (let [k (get-timestamp-property e)]
      (if k
        (db-based-build-between-two-arg e)
        (build-journal-between-two-arg e)))

    ;; (between created_at -1d today)
    (= 4 (count e))
    (db-based-build-between-three-arg e)))

(defn ->db-property-value
  "Parses property values for DB graphs"
  [k v]
  (let [v' (if (symbol? v) (str v) v)]
    (cond (string? v')
          (if (string/starts-with? v' "#")
            (subs v' 1)
            (or (page-ref/get-page-name v') v'))
          ;; Convert number pages to string
          (and (double? v) (= :node (:logseq.property/type (d/entity *current-db* k))))
          (str v)
          :else
          v')))

(defn- ->db-keyword-property
  "Returns property db-ident given case sensitive property names for db graphs"
  [property-name]
  (if (qualified-keyword? property-name)
    property-name
    (or (some->> (name property-name)
                 (d/q '[:find [(pull ?b [:db/ident]) ...]
                        :in $ ?title
                        :where [?b :block/tags :logseq.class/Property] [?b :block/title ?title]]
                      *current-db*)
                 first
                 :db/ident)
        ;; Don't return nil as that incorrectly matches all properties
        ::no-property-found)))

(defn- build-property-two-arg
  [e {:keys [private-property?]}]
  (let [k (->db-keyword-property (nth e 1))
        v (nth e 2)
        v' (->db-property-value k v)
        property (when (qualified-keyword? k)
                   (d/entity *current-db* k))
        ref-type? (= :db.type/ref (:db/valueType property))
        default-value (if ref-type?
                        (when-let [value (:logseq.property/default-value property)]
                          (or (:block/title value)
                              (:logseq.property/value value)))
                        (:logseq.property/scalar-default-value property))
        default-value? (and (some? v') (= default-value v'))
        rule (if private-property?
               (cond
                 (and ref-type? default-value?)
                 :private-ref-property-with-default
                 ref-type?
                 :private-ref-property
                 default-value?
                 :private-scalar-property-with-default
                 :else
                 :private-scalar-property)
               (cond
                 (and ref-type? default-value?)
                 :ref-property-with-default
                 ref-type?
                 :ref-property
                 default-value?
                 :scalar-property-with-default
                 :else
                 :scalar-property))]
    {:query (list (symbol (name rule)) '?b k v')
     :rules [rule]}))

(defn- build-property-one-arg
  [e {:keys [private-property?]}]
  (let [k (->db-keyword-property (nth e 1))]
    (if private-property?
      {:query (list 'has-private-simple-query-property '?b k)
       :rules [:has-private-simple-query-property]}
      {:query (list 'has-simple-query-property '?b k)
       :rules [:has-simple-query-property]})))

(defn- build-property [e env]
  (cond
    (= 3 (count e))
    (build-property-two-arg e env)

    (= 2 (count e))
    (build-property-one-arg e env)))

(defn- build-task
  [e]
  (let [markers (if (coll? (first (rest e)))
                  (first (rest e))
                  (rest e))]
    (when (seq markers)
      (let [markers' (set (map (comp common-util/capitalize-all name) markers))]
        {:query (list 'task '?b (set markers'))
         :rules [:task]}))))

(defn- build-priority
  [e]
  (let [priorities (if (coll? (first (rest e)))
                     (first (rest e))
                     (rest e))]
    (when (seq priorities)
      (let [priorities (set (map (comp string/capitalize name) priorities))]
        {:query (list 'priority '?b priorities)
         :rules [:priority]}))))

(defn- build-tags
  [e]
  (let [tags (if (coll? (first (rest e)))
               (first (rest e))
               (rest e))
        tags (map name tags)]
    (when (seq tags)
      (let [tags (set (map (comp page-ref/get-page-name!) tags))]
        {:query (list 'tags
                      '?b
                      (->> tags
                           (mapcat (fn [tag-name]
                                     (when-let [tag-id (if (common-util/uuid-string? tag-name)
                                                         [:block/uuid (uuid tag-name)]
                                                         (first (ldb/page-exists? *current-db* tag-name #{:logseq.class/Tag})))]
                                       (when-let [tag (d/entity *current-db* tag-id)]
                                         (->> (db-class/get-structured-children *current-db* (:db/id tag))
                                              (cons (:db/id tag)))))))
                           set))
         :rules [:tags]}))))

(defn- build-sample
  [e sample]
  (when-let [num (second e)]
    (when (integer? num)
      (reset! sample num)
      ;; blank b/c this post-process filter doesn't effect query
      {})))

(defn- build-page
  [e]
  (let [page-name (page-ref/get-page-name! (str (first (rest e))))
        page-name (common-util/page-name-sanity-lc page-name)]
    {:query (list 'page '?b page-name)
     :rules [:page]}))

(defn- build-page-ref
  [e]
  (let [page-name (-> (page-ref/get-page-name! e)
                      (common-util/page-name-sanity-lc))
        page (ldb/get-page *current-db* page-name)]
    (when page
      {:query (list 'page-ref '?b (:db/id page))
       :rules [:page-ref]})))

(defn- build-self-ref
  [e]
  (let [page-name (-> (page-ref/get-page-name! e)
                      (common-util/page-name-sanity-lc))
        page (ldb/get-page *current-db* page-name)]
    (when page
      {:query (list 'self-ref '?b (:db/id page))
       :rules [:self-ref]})))

(defn- build-block-content [e]
  {:query (list 'block-content '?b e)
   :rules [:block-content]})

(defn- datalog-clause?
  [e]
  (and
   (coll? e)
   (or
    (list? (first e))
    (and (>= (count e) 2)
         (or
          ;; variable
          (string/starts-with? (str (first e)) "?")
          ;; function
          (list? (first e)))))))

(defn build-query
  "This fn converts a form/list in a query e.g. `(operator arg1 arg2)` to its datalog
  equivalent. This fn is called recursively on sublists for boolean operators
  `and`, `or` and `not`. This fn should return a map with :query and :rules or nil.

Some bindings in this fn:

* e - the list being processed
* fe - the query operator e.g. `property`"
  ([e env]
   (build-query e (assoc env :vars (atom {})) 0))
  ([e {:keys [form blocks? sample current-filter] :as env :or {blocks? (atom nil)}} level]
   ; {:post [(or (nil? %) (map? %))]}
   (let [fe (first e)
         fe (when fe
              (cond
                (list? fe)
                fe
                (or (symbol? fe) (keyword? fe))
                (symbol (string/lower-case (name fe)))
                :else
                (string/lower-case (str fe))))
         page-ref? (page-ref/page-ref? e)]
     (when (or
            (contains? #{'between 'property 'private-property 'todo 'task 'priority 'page} fe)
            (and (not page-ref?) (string? e)))
       (reset! blocks? true))
     (cond
       (nil? e)
       nil

       (datalog-clause? e)
       {:query [e]
        :rules []}

       (and (= fe 'and) (every? page-ref/page-ref? (rest e)))
       (build-query (concat e [(cons 'or (rest e))]) env level)

       page-ref?
       (if (or (= current-filter 'or) (= form e))
         (build-self-ref e)
         (build-page-ref e))

       (string? e)                      ; block content full-text search, could be slow
       (build-block-content e)

       (contains? #{'and 'or 'not} fe)
       (build-and-or-not e env level fe)

       (= 'between fe)
       (build-between e)

       (= 'property fe)
       (build-property e env)

       (= 'private-property fe)
       (build-property e (assoc env :private-property? true))

       ;; task is the new name and todo is the old one
       (or (= 'todo fe) (= 'task fe))
       (build-task e)

       (= 'priority fe)
       (build-priority e)

       (= 'page fe)
       (build-page e)

       (= 'sample fe)
       (build-sample e sample)

       (= 'tags fe)
       (build-tags e)

       :else
       nil))))

;; parse fns
;; =========

(def pre-transform shared-query-dsl/pre-transform)

(defn- lvar? [x]
  (and (symbol? x) (= \? (first (name x)))))

(defn- collect-vars-by-polarity
  "Returns {:pos #{?vars} :neg #{?vars}}.
   Vars inside (not ...) are counted as negative."
  [form]
  (let [pos (volatile! #{})
        neg (volatile! #{})]
    (letfn [(walk* [x positive?]
              (cond
                (lvar? x)
                (vswap! (if positive? pos neg) conj x)

                (and (seq? x) (= 'not (first x)))
                (doseq [c (rest x)] (walk* c false))

                (sequential? x)
                (doseq [c x] (walk* c positive?))

                (map? x)
                (do (doseq [k (keys x)] (walk* k positive?))
                    (doseq [v (vals x)] (walk* v positive?)))

                :else nil))]
      (walk* form true)
      {:pos @pos :neg @neg})))

(defn- add-bindings!
  [q]
  (let [{:keys [pos neg]} (collect-vars-by-polarity q)

        appears?      (fn [v] (or (contains? pos v) (contains? neg v)))
        needs-domain? (fn [v] (and (appears? v) (not (contains? pos v))))

        b-need? (needs-domain? '?b)
        p-need? (needs-domain? '?p)

        ;; CASE 1: both needed → link them, do NOT enumerate all blocks
        bindings
        (cond
          (and b-need? p-need?)
          [['?b :block/page '?p]]

          ;; CASE 2: only ?b needed → last-resort domain (true global negation)
          b-need?
          [['?b :block/uuid]
           '[(missing? $ ?b :logseq.property/built-in?)]]

          ;; CASE 3: only ?p needed
          p-need?
          [['?p :block/name]]

          ;; CASE 4: both already positive → optional link (cheap + useful)
          (and (contains? pos '?b) (contains? pos '?p))
          [['?b :block/page '?p]]

          :else
          nil)]
    (if (seq bindings)
      (concat bindings q)   ;; IMPORTANT: bindings FIRST
      q)))

(def simplify-query shared-query-dsl/simplify-query)
(def custom-readers shared-query-dsl/custom-readers)
(defn parse
  [s db {:keys [cards?]}]
  (when (and (string? s)
             (not (string/blank? s)))
    (binding [*current-db* db]
      (let [s (if (= \# (first s)) (page-ref/->page-ref (subs s 1)) s)
            form (some->> s
                          (pre-transform)
                          (reader/read-string custom-readers))
            sort-by (atom nil)
            blocks? (atom nil)
            sample (atom nil)
            form (simplify-query form)
            {result :query rules :rules}
            (when form (build-query form {:form form
                                          :sort-by sort-by
                                          :blocks? blocks?
                                          :sample sample
                                          :cards? cards?}))
            result' (when (seq result)
                      (let [key (if (coll? (first result))
                                ;; Only queries for this branch are not's like:
                                ;; [(not (page-ref ?b "page 2"))]
                                  (keyword (ffirst result))
                                  (keyword (first result)))]
                        (add-bindings! (if (= key :and) (rest result) result))))
            extract-rules (fn [rules]
                            (rules/extract-rules rules/db-query-dsl-rules rules {:deps rules/rules-dependencies}))
            rule-names (if (contains? (set rules) :page-ref)
                         (conj (set rules) :self-ref)
                         (set rules))
            rules' (extract-rules rule-names)]
        {:query result'
         :rules rules'
         :rule-names rule-names
         :sort-by @sort-by
         :blocks? (boolean @blocks?)
         :sample sample}))))

;; Main fns
;; ========

(defn query-wrapper
  [where {:keys [blocks? block-attrs]}]
  (let [block-attrs (or block-attrs '[*])
        q (if blocks?                   ; FIXME: it doesn't need to be either blocks or pages
            `[:find (~'pull ~'?b ~block-attrs)
              :in ~'$ ~'%
              :where]
            '[:find (pull ?p [*])
              :in $ %
              :where])]
    (if (coll? (first where))
      (apply conj q where)
      (conj q where))))

(defn parse-query
  ([q db] (parse-query q db {}))
  ([q db options]
   (let [q' (resolve-dynamic-template q options)]
     (parse q' db options))))

(def ^:private query-result-watch-attrs
  #{:block/uuid :block/title :block/name :block/parent})

(def ^:private attr-watch-safe-rules
  #{:between :block-content :page})

(defn query-watch-dependencies
  "Return attribute-level dependencies for a DSL query when its rules are safe to inspect.

  Queries that rely on dynamic class or property semantics remain opaque and keep the
  graph-level dependency until those semantics have their own invalidation keys."
  [query-string db options]
  (if (or (not (string? query-string))
          (string/blank? query-string)
          (common-util/wrapped-by-quotes? query-string))
    {:attrs #{} :opaque? true}
    (let [{query* :query :keys [rule-names rules]} (parse-query query-string db options)
          safe? (every? attr-watch-safe-rules rule-names)
          forms (tree-seq coll? seq [query* rules])
          attrs (into query-result-watch-attrs
                      (keep (fn [form]
                              (when (and (vector? form)
                                         (<= 2 (count form))
                                         (qualified-keyword? (second form)))
                                (second form)))
                      forms))]
      {:attrs attrs
       :opaque? (or (not safe?) (empty? query*))})))

(def db-block-attrs
  "Block attributes for db graph queries"
  ;; only needs :db/id for query/view
  [:db/id])

(defn- sample-results
  [result sample]
  (if (and sample (pos-int? sample))
    (take sample (shuffle result))
    result))

(defn- with-raw-title
  [value]
  (if (and (map? value)
           (contains? value :block/title)
           (not (contains? value :block/raw-title)))
    (assoc value :block/raw-title (:block/title value))
    value))

(defn- query-result-tuples
  [result]
  (let [tuples (cond
                 (contains? result :tuples)
                 (:tuples result)

                 :else
                 result)]
    (mapv (fn [tuple]
            (mapv with-raw-title
                  (cond
                    (vector? tuple)
                    tuple

                    (map? tuple)
                    [tuple]

                    (and (object? tuple) (number? (.-length ^js tuple)))
                    (vec (array-seq tuple))

                    (seqable? tuple)
                    (vec tuple)

                    :else
                    [tuple])))
          tuples)))

(defn execute-query
  [query-string db {:keys [cards? block-attrs] :as opts}]
  (when (and (string? query-string) (not= "\"\"" query-string))
    (let [{query* :query :keys [rules sample]} (parse-query query-string db opts)
          query* (if cards?
                   (let [card-id (:db/id (d/entity db :logseq.class/Card))]
                     (common-util/concat-without-nil
                      [['?b :block/tags card-id]]
                      (if (coll? (first query*)) query* [query*])))
                   query*)]
      (when-let [query' (some-> query* (query-wrapper {:blocks? true
                                                       :block-attrs block-attrs}))]
        (-> (d/q query' db rules)
            query-result-tuples
            (sample-results (some-> sample deref)))))))

(defn execute-custom-query
  [query-m db {:keys [block-attrs]}]
  (when (seq (:query query-m))
    (let [query-string (resolve-dynamic-template (pr-str (:query query-m)) {})
          {query* :query :keys [blocks? rules]} (parse query-string db {})]
      (when-let [query' (some-> query* (query-wrapper {:blocks? blocks?
                                                       :block-attrs block-attrs}))]
        (query-result-tuples (d/q query' db rules))))))

(comment
  (parse "(and [[foo]] [[bar]])" nil {}))