Add support for page property queries

page-property-queries test passes

deps/db/src/logseq/db/rules.cljc

@@ -146,7 +146,46 @@
   "Rules used by frontend.query.dsl for db graphs"
   (merge
    query-dsl-rules
-   {:has-property
+   {:has-page-property
+    '[(has-page-property ?p ?prop)
+      [?p :block/name]
+      [?p :block/properties ?bp]
+      [(name ?prop) ?prop-name-str]
+      [?prop-b :block/name ?prop-name-str]
+      [?prop-b :block/type "property"]
+      [?prop-b :block/uuid ?prop-uuid]
+      [(get ?bp ?prop-uuid)]]
+
+    :page-property
+    '[;; Clause 1: Match non-ref values
+      [(page-property ?p ?key ?val)
+       [?p :block/name]
+       [?p :block/properties ?prop]
+       [(name ?key) ?key-str]
+       [?prop-b :block/name ?key-str]
+       [?prop-b :block/type "property"]
+       [?prop-b :block/uuid ?prop-uuid]
+       [(get ?prop ?prop-uuid) ?v]
+       (or ([= ?v ?val])
+           [(contains? ?v ?val)])]
+
+      ;; Clause 2: Match values joined by refs
+      [(page-property ?p ?key ?val)
+       [?p :block/name]
+       [?p :block/properties ?prop]
+       [(name ?key) ?key-str]
+       [?prop-b :block/name ?key-str]
+       [?prop-b :block/type "property"]
+       [?prop-b :block/uuid ?prop-uuid]
+       [(get ?prop ?prop-uuid) ?v]
+       [(str ?val) ?str-val]
+      ;; str-val is for integer pages that aren't strings
+       [?prop-val-b :block/original-name ?str-val]
+       [?prop-val-b :block/uuid ?val-uuid]
+       (or ([= ?v ?val-uuid])
+           [(contains? ?v ?val-uuid)])]]
+
+    :has-property
     '[(has-property ?b ?prop)
       [?b :block/properties ?bp]
       [(missing? $ ?b :block/name)]
@@ -169,7 +208,7 @@
        (or [(= ?v ?val)]
            [(contains? ?v ?val)])]
 
-      ;; Clause 2: Match values joined by ref values
+      ;; Clause 2: Match values joined by refs
       [(property ?b ?key ?val)
        [?b :block/properties ?prop]
        [(missing? $ ?b :block/name)]

src/test/frontend/test/helper.cljs

@@ -26,35 +26,53 @@
   (start-test-db!))
 
 (defn- parse-property-value [value]
-  (if-let [refs (seq (map second (re-seq #"\[\[(.*?)\]\]" value)))]
+  (if-let [refs (seq (map #(or (second %) (get % 2))
+                          (re-seq #"#(\S+)|\[\[(.*?)\]\]" value)))]
     (set refs)
     (if-some [new-val (text/parse-non-string-property-value value)]
       new-val
       value)))
 
-(defn- build-blocks
-  "Parses properties and content from a markdown block"
+(defn- build-block-properties
+  "Parses out properties from a file's content and associates it with the page name
+   or block content"
   [file-content]
   (if (string/includes? file-content "\n-")
-    (->> (string/split file-content #"\n-\s*")
-         (mapv (fn [s]
-                 (let [[content & props] (string/split-lines s)]
-                   [content (->> props
-                                 (map #(let [[k v] (string/split % #"::\s*" 2)]
-                                         [(keyword k) (parse-property-value v)]))
-                                 (into {}))]))))
-    ;; TODO: page-properties
-    []))
+    {:block-properties
+     (->> (string/split file-content #"\n-\s*")
+          (mapv (fn [s]
+                  (let [[content & props] (string/split-lines s)]
+                    [content (->> props
+                                  (map #(let [[k v] (string/split % #"::\s*" 2)]
+                                          [(keyword k) (parse-property-value v)]))
+                                  (into {}))]))))}
+    {:page-properties
+     (->> file-content
+          string/split-lines
+          (map #(let [[k v] (string/split % #"::\s*" 2)]
+                  [(keyword k) (parse-property-value v)]))
+          (into {}))}))
+
+(defn- update-file-for-db-graph
+  "Adds properties by block/page for a file and updates block content"
+  [file]
+  (let [{:keys [block-properties page-properties]}
+        (build-block-properties (:file/content file))]
+    (if page-properties
+      (merge file
+             {:file/block-properties [[(or (second (re-find #"([^/]+).md" (:file/path file)))
+                                           (throw (ex-info "No page found" {})))
+                                       page-properties]]
+              :page-properties? true})
+      (merge file
+             {:file/block-properties block-properties
+                                 ;; Rewrite content to strip it of properties which shouldn't be in content
+              :file/content (string/join "\n"
+                                         (map (fn [x] (str "- " (first x))) block-properties))}))))
 
-;; Currently this only works for load-test-files that have added a :file/blocks for each file arg
 (defn- load-test-files-for-db-graph
   [files*]
-  (let [files (mapv #(let [blocks (build-blocks (:file/content %))]
-                       (merge %
-                              {:file/blocks blocks
-                               :file/content (string/join "\n"
-                                                          (map (fn [x] (str "- " (first x))) blocks))}))
-                    files*)]
+  (let [files (mapv update-file-for-db-graph files*)]
     ;; TODO: Use sqlite instead of file graph to create client db
     (repo-handler/parse-files-and-load-to-db!
      test-db
@@ -65,24 +83,33 @@
                                        :where
                                        [?b :block/content ?content]
                                        [?b :block/uuid ?uuid]]
-                                     (frontend.db/get-db test-db)))
+                                     (db/get-db test-db)))
+          page-name-map (into {} (d/q
+                                  '[:find ?name ?uuid
+                                    :where
+                                    [?b :block/name ?name]
+                                    [?b :block/uuid ?uuid]]
+                                  (db/get-db test-db)))
           property-uuids (->> files
-                              (mapcat #(->> % :file/blocks (map second) (mapcat keys)))
+                              (mapcat #(->> % :file/block-properties (map second) (mapcat keys)))
                               set
-                              (map #(vector % (random-uuid)))
+                              ;; Property pages may be created by file graphs automatically,
+                              ;; usually by page properties. Delete this if file graphs are long
+                              ;; used to create datascript db
+                              (map #(vector % (or (page-name-map (name %)) (random-uuid))))
                               (into {}))
             ;; from upsert-property!
-          property-tx (mapv (fn [[prop-name uuid]]
-                              (outliner-core/block-with-timestamps
-                               {:block/schema {:type :default}
-                                :block/original-name (name prop-name)
-                                :block/name (string/lower-case (name prop-name))
-                                :block/uuid uuid
-                                :block/type "property"}))
-                            property-uuids)
+          new-properties-tx (mapv (fn [[prop-name uuid]]
+                                    (outliner-core/block-with-timestamps
+                                     {:block/uuid uuid
+                                      :block/schema {:type :default}
+                                      :block/original-name (name prop-name)
+                                      :block/name (string/lower-case (name prop-name))
+                                      :block/type "property"}))
+                                  property-uuids)
           page-uuids (->> files
                           (mapcat #(->> %
-                                        :file/blocks
+                                        :file/block-properties
                                         (map second)
                                         (mapcat (fn [m]
                                                   (->> m vals (filter set?) (apply set/union))))))
@@ -96,26 +123,30 @@
                             :block/uuid uuid}))
                         page-uuids)
             ;; from add-property!
-          block-tx (mapcat
-                    (fn [file]
+          block-properties-tx
+          (mapcat
+           (fn [{:keys [page-properties?] :as file}]
+             (map
+              (fn [[page-name-or-content props]]
+                {:block/uuid (if page-properties?
+                               (or (page-name-map page-name-or-content)
+                                   (throw (ex-info "No uuid for page" {:page-name page-name-or-content})))
+                               (or (content-uuid-map page-name-or-content)
+                                   (throw (ex-info "No uuid for content" {:content page-name-or-content}))))
+                 :block/properties
+                 (->> props
                       (map
-                       (fn [[content props]]
-                         {:block/uuid (or (content-uuid-map content)
-                                          (throw (ex-info "No uuid for content" {:content content})))
-                          :block/properties
-                          (->> props
-                               (map
-                                (fn [[prop-name val]]
-                                  [(or (property-uuids prop-name)
-                                       (throw (ex-info "No uuid for property" {:name prop-name})))
-                                   (if (set? val)
-                                     (set (map (fn [p] (or (page-uuids p) (throw (ex-info "No uuid for page" {:name p}))))
-                                               val))
-                                     val)]))
-                               (into {}))})
-                       (:file/blocks file)))
-                    files)]
-      (db/transact! test-db (vec (concat page-tx property-tx block-tx))))))
+                       (fn [[prop-name val]]
+                         [(or (property-uuids prop-name)
+                              (throw (ex-info "No uuid for property" {:name prop-name})))
+                          (if (set? val)
+                            (set (map (fn [p] (or (page-uuids p) (throw (ex-info "No uuid for page" {:name p}))))
+                                      val))
+                            val)]))
+                      (into {}))})
+              (:file/block-properties file)))
+           files)]
+      (db/transact! test-db (vec (concat page-tx new-properties-tx block-properties-tx))))))
 
 (defn load-test-files
   "Given a collection of file maps, loads them into the current test-db.