enhance: create sqlite.build ns as a better

load-test-files helper for db graphs and deps.
Most of this ns is split off from create-graph.
Migrated pipeline-test to correct outliner dep and
moved previous pipeline-test to correct db dep
experiment/tanstack-table
Gabriel Horner 2024-06-03 07:53:47 -04:00
parent 36901f9e42
commit 2456deb097
9 changed files with 473 additions and 451 deletions

383
deps/db/src/logseq/db/sqlite/build.cljs vendored Normal file
View File

@ -0,0 +1,383 @@
(ns logseq.db.sqlite.build
"This ns provides fns to build tx-data for DB graphs. This tx-data is used to
create DB graphs that persist to sqlite or for testing with in-memory
databases. See build-blocks-tx which is the main fn to build tx data"
(:require [logseq.db.sqlite.util :as sqlite-util]
[logseq.db.frontend.property.build :as db-property-build]
[logseq.common.util :as common-util]
[clojure.string :as string]
[clojure.set :as set]
[datascript.core :as d]
[logseq.db.frontend.property :as db-property]
[logseq.db.frontend.order :as db-order]
[logseq.db.frontend.property.type :as db-property-type]
[logseq.db.frontend.class :as db-class]
[logseq.db.frontend.db-ident :as db-ident]
[logseq.common.util.page-ref :as page-ref]
[logseq.db.frontend.content :as db-content]))
(defn- translate-property-value
"Translates a property value for create-graph edn. A value wrapped in vector
may indicate a reference type e.g. [:page \"some page\"]"
[val page-uuids]
(if (vector? val)
(case (first val)
;; Converts a page name to block/uuid
:page
(if-let [page-uuid (page-uuids (second val))]
[:block/uuid page-uuid]
(throw (ex-info (str "No uuid for page '" (second val) "'") {:name (second val)})))
:block/uuid
val)
val))
(defn- get-ident [all-idents kw]
(or (get all-idents kw)
(throw (ex-info (str "No ident found for " (pr-str kw)) {}))))
(defn- ->block-properties [properties page-uuids all-idents]
(->>
(map
(fn [[prop-name val]]
[(get-ident all-idents prop-name)
;; set indicates a :many value
(if (set? val)
(set (map #(translate-property-value % page-uuids) val))
(translate-property-value val page-uuids))])
properties)
(into {})))
(defn- create-page-uuids
"Creates maps of unique page names, block contents and property names to their uuids"
[pages-and-blocks]
(->> pages-and-blocks
(map :page)
(map (juxt #(or (:block/original-name %) (:block/name %))
:block/uuid))
(into {})))
(def current-db-id (atom 0))
(def new-db-id
"Provides the next temp :db/id to use in a create-graph transact!"
#(swap! current-db-id dec))
(defn- create-property-value
[block property-ident value]
(db-property-build/build-property-value-block
block
property-ident
;; FIXME: Remove when fixed in UI
(str value)))
;; TODO: Use build-property-values-tx-m
(defn- ->property-value-tx-m
"Given a new block and its properties, creates a map of properties which have values of property value tx.
This map is used for both creating the new property values and then adding them to a block"
[new-block properties properties-config all-idents]
(->> properties
(map (fn [[k v]]
(when (and (db-property-type/value-ref-property-types (get-in properties-config [k :block/schema :type]))
;; TODO: Support translate-property-value without this hack
(not (vector? v)))
[k (if (set? v)
(set (map #(create-property-value new-block (get-ident all-idents k) %) v))
(create-property-value new-block (get-ident all-idents k) v))])))
(into {})))
(defn- extract-content-refs
"Extracts basic refs from :block/content like `[[foo]]`. Adding more ref support would
require parsing each block with mldoc and extracting with text/extract-refs-from-mldoc-ast"
[s]
;; FIXME: Better way to ignore refs inside a macro
(if (string/starts-with? s "{{")
[]
(map second (re-seq page-ref/page-ref-re s))))
(defn- ->block-tx [{:keys [properties] :as m} properties-config page-uuids all-idents page-id]
(let [new-block {:db/id (new-db-id)
:block/format :markdown
:block/page {:db/id page-id}
:block/order (db-order/gen-key nil)
:block/parent (or (:block/parent m) {:db/id page-id})}
pvalue-tx-m (->property-value-tx-m new-block properties properties-config all-idents)
ref-names (extract-content-refs (:block/content m))]
(cond-> []
;; Place property values first since they are referenced by block
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj (merge (dissoc m :properties)
(sqlite-util/block-with-timestamps new-block)
(when (seq properties)
(->block-properties (merge properties (db-property-build/build-properties-with-ref-values pvalue-tx-m))
page-uuids all-idents))
(when (seq ref-names)
(let [block-refs (mapv #(hash-map :block/uuid
(or (page-uuids %)
(throw (ex-info (str "No uuid for page ref name" (pr-str %)) {})))
:block/original-name %)
ref-names)]
{:block/content (db-content/page-ref->special-id-ref (:block/content m) block-refs)
:block/refs (map #(dissoc % :block/original-name) block-refs)})))))))
(defn- build-properties-tx [properties page-uuids all-idents]
(let [property-db-ids (->> (keys properties)
(map #(vector (name %) (new-db-id)))
(into {}))
new-properties-tx (vec
(mapcat
(fn [[prop-name {:keys [schema-classes] :as prop-m}]]
(if (:closed-values prop-m)
(let [db-ident (get-ident all-idents prop-name)]
(db-property-build/build-closed-values
db-ident
prop-name
(assoc prop-m :db/ident db-ident)
{:property-attributes
{:db/id (or (property-db-ids (name prop-name))
(throw (ex-info "No :db/id for property" {:property prop-name})))}}))
(let [new-block
(merge (sqlite-util/build-new-property (get-ident all-idents prop-name)
(:block/schema prop-m)
{:block-uuid (:block/uuid prop-m)})
{:db/id (or (property-db-ids (name prop-name))
(throw (ex-info "No :db/id for property" {:property prop-name})))})
pvalue-tx-m (->property-value-tx-m new-block (:properties prop-m) properties all-idents)]
(cond-> []
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj
(merge
new-block
(when-let [props (not-empty (:properties prop-m))]
(->block-properties (merge props (db-property-build/build-properties-with-ref-values pvalue-tx-m)) page-uuids all-idents))
(when (seq schema-classes)
{:property/schema.classes
(mapv #(hash-map :db/ident (get-ident all-idents (keyword %)))
schema-classes)})))))))
properties))]
new-properties-tx))
(defn- build-classes-tx [classes properties-config uuid-maps all-idents]
(let [class-db-ids (->> (keys classes)
(map #(vector (name %) (new-db-id)))
(into {}))
classes-tx (vec
(mapcat
(fn [[class-name {:keys [class-parent schema-properties] :as class-m}]]
(let [new-block
(sqlite-util/build-new-class
{:block/name (common-util/page-name-sanity-lc (name class-name))
:block/original-name (name class-name)
:block/uuid (d/squuid)
:db/ident (get-ident all-idents class-name)
:db/id (or (class-db-ids (name class-name))
(throw (ex-info "No :db/id for class" {:class class-name})))})
pvalue-tx-m (->property-value-tx-m new-block (:properties class-m) properties-config all-idents)]
(cond-> []
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj
(merge
new-block
(dissoc class-m :properties :class-parent :schema-properties)
(when-let [props (not-empty (:properties class-m))]
(->block-properties (merge props (db-property-build/build-properties-with-ref-values pvalue-tx-m)) uuid-maps all-idents))
(when class-parent
{:class/parent
(or (class-db-ids class-parent)
(throw (ex-info (str "No :db/id for " class-parent) {})))})
(when schema-properties
{:class/schema.properties
(mapv #(hash-map :db/ident (get-ident all-idents (keyword %)))
schema-properties)}))))))
classes))]
classes-tx))
(defn- validate-options
[{:keys [pages-and-blocks properties classes]}]
(let [page-block-properties (->> pages-and-blocks
(map #(-> (:blocks %) vec (conj (:page %))))
(mapcat #(->> % (map :properties) (mapcat keys)))
set)
property-class-properties (->> (vals properties)
(concat (vals classes))
(mapcat #(keys (:properties %)))
set)
undeclared-properties (-> page-block-properties
(into property-class-properties)
(set/difference (set (keys properties))))
invalid-pages (remove #(or (:block/original-name %) (:block/name %))
(map :page pages-and-blocks))]
(assert (empty? invalid-pages)
(str "The following pages did not have a name attribute: " invalid-pages))
(assert (every? #(get-in % [:block/schema :type]) (vals properties))
"All properties must have :block/schema and :type")
(assert (empty? undeclared-properties)
(str "The following properties used in EDN were not declared in :properties: " undeclared-properties))))
;; TODO: How to detect these idents don't conflict with existing? :db/add?
(defn- create-all-idents
[properties classes graph-namespace]
(let [property-idents (->> (keys properties)
(map #(vector %
(if graph-namespace
(db-ident/create-db-ident-from-name (str (name graph-namespace) ".property")
(name %))
(db-property/create-user-property-ident-from-name (name %)))))
(into {}))
_ (assert (= (count (set (vals property-idents))) (count properties)) "All property db-idents must be unique")
class-idents (->> (keys classes)
(map #(vector %
(if graph-namespace
(db-ident/create-db-ident-from-name (str (name graph-namespace) ".class")
(name %))
(db-class/create-user-class-ident-from-name (name %)))))
(into {}))
_ (assert (= (count (set (vals class-idents))) (count classes)) "All class db-idents must be unique")
all-idents (merge property-idents class-idents)]
(assert (= (count all-idents) (+ (count property-idents) (count class-idents)))
"Class and property db-idents have no overlap")
all-idents))
(defn- build-pages-and-blocks-tx
[pages-and-blocks all-idents page-uuids {:keys [page-id-fn properties]
:or {page-id-fn :db/id}}]
(let [new-pages-from-refs
(->> pages-and-blocks
(mapcat
(fn [{:keys [blocks]}]
(->> blocks
(mapcat #(extract-content-refs (:block/content %)))
(remove page-uuids))))
(map #(hash-map :page {:block/original-name % :block/uuid (random-uuid)})))
pages-and-blocks' (concat pages-and-blocks new-pages-from-refs)
;; TODO: Make page-uuids' available to all fns once pages only take :block/original-name
page-uuids' (into page-uuids (map #(vector (get-in % [:page :block/original-name])
(get-in % [:page :block/uuid]))
new-pages-from-refs))]
(vec
(mapcat
(fn [{:keys [page blocks]}]
(let [new-page (merge
{:db/id (or (:db/id page) (new-db-id))
:block/original-name (or (:block/original-name page) (string/capitalize (:block/name page)))
:block/name (or (:block/name page) (common-util/page-name-sanity-lc (:block/original-name page)))
:block/format :markdown}
(dissoc page :properties :db/id :block/name :block/original-name))
pvalue-tx-m (->property-value-tx-m new-page (:properties page) properties all-idents)]
(into
;; page tx
(cond-> []
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj
(sqlite-util/block-with-timestamps
(merge
new-page
(when (seq (:properties page))
(->block-properties (merge (:properties page) (db-property-build/build-properties-with-ref-values pvalue-tx-m))
page-uuids'
all-idents))))))
;; blocks tx
(reduce (fn [acc m]
(into acc
(->block-tx m properties page-uuids' all-idents (page-id-fn new-page))))
[]
blocks))))
pages-and-blocks'))))
(defn- split-blocks-tx
"Splits a vec of maps tx into maps that can immediately be transacted,
:init-tx, and maps that need to be transacted after :init-tx, :block-props-tx, in order to use
the correct schema e.g. user properties with :db/cardinality"
[blocks-tx]
(let [property-idents (keep #(when (:db/cardinality %) (:db/ident %)) blocks-tx)
[init-tx block-props-tx]
(reduce (fn [[init-tx* block-props-tx*] m]
(let [props (select-keys m property-idents)]
[(conj init-tx* (apply dissoc m property-idents))
(if (seq props)
(conj block-props-tx*
(merge {:block/uuid (or (:block/uuid m)
(throw (ex-info "No :block/uuid for block" {:block m})))}
props))
block-props-tx*)]))
[[] []]
blocks-tx)]
{:init-tx init-tx
:block-props-tx block-props-tx}))
(defn build-blocks-tx
"Given an EDN map for defining pages, blocks and properties, this creates a map
with two keys of transactable data for use with d/transact!. The :init-tx key
must be transacted first and the :block-props-tx can be transacted after.
The blocks that can be created have the following limitations:
* Only top level blocks can be easily defined. Other level blocks can be
defined but they require explicit setting of attributes like :block/order and :block/parent
* Block content containing page refs or tags is not supported yet
The EDN map has the following keys:
* :pages-and-blocks - This is a vector of maps containing a :page key and optionally a :blocks
key when defining a page's blocks. More about each key:
* :page - This is a datascript attribute map e.g. `{:block/name \"foo\"}` .
:block/name is required and :properties can be passed to define page properties
* :blocks - This is a vec of datascript attribute maps e.g. `{:block/content \"bar\"}`.
:block/content is required and :properties can be passed to define block properties
* :properties - This is a map to configure properties where the keys are property name keywords
and the values are maps of datascript attributes e.g. `{:block/schema {:type :checkbox}}`.
Additional keys available:
* :closed-values - Define closed values with a vec of maps. A map contains keys :uuid, :value and :icon.
* :properties - Define properties on a property page.
* :schema-classes - Vec of class names. Defines a property's range classes
* :classes - This is a map to configure classes where the keys are class name keywords
and the values are maps of datascript attributes e.g. `{:block/original-name \"Foo\"}`.
Additional keys available:
* :properties - Define properties on a class page
* :class-parent - Add a class parent by its name
* :schema-properties - Vec of property names. Defines properties that a class gives to its objects
* :graph-namespace - namespace to use for db-ident creation. Useful when importing an ontology
* :page-id-fn - custom fn that returns ent lookup id for page refs e.g. `[:block/uuid X]`
Default is :db/id
The :properties in :pages-and-blocks, :properties and :classes is a map of
property name keywords to property values. Multiple property values for a many
cardinality property are defined as a set. The following property types are
supported: :default, :url, :checkbox, :number, :page and :date. :checkbox and
:number values are written as booleans and integers/floats. :page references
are written as vectors e.g. `[:page \"PAGE NAME\"]`"
[{:keys [pages-and-blocks properties classes graph-namespace]
:as options}]
(let [_ (validate-options options)
;; add uuids before tx for refs in :properties
pages-and-blocks' (mapv (fn [{:keys [page blocks]}]
(cond-> {:page (merge {:block/uuid (random-uuid)} page)}
(seq blocks)
(assoc :blocks (mapv #(merge {:block/uuid (random-uuid)} %) blocks))))
pages-and-blocks)
page-uuids (create-page-uuids pages-and-blocks')
all-idents (create-all-idents properties classes graph-namespace)
properties-tx (build-properties-tx properties page-uuids all-idents)
classes-tx (build-classes-tx classes properties page-uuids all-idents)
class-ident->id (->> classes-tx (map (juxt :db/ident :db/id)) (into {}))
;; Replace idents with db-ids to avoid any upsert issues
properties-tx' (mapv (fn [m]
(if (:property/schema.classes m)
(update m :property/schema.classes
(fn [cs]
(mapv #(or (some->> (:db/ident %) class-ident->id (hash-map :db/id))
(throw (ex-info (str "No :db/id found for :db/ident " (pr-str (:db/ident %))) {})))
cs)))
m))
properties-tx)
pages-and-blocks-tx (build-pages-and-blocks-tx pages-and-blocks' all-idents page-uuids options)]
;; Properties first b/c they have schema and are referenced by all. Then classes b/c they can be referenced by pages. Then pages
(split-blocks-tx (concat properties-tx'
classes-tx
pages-and-blocks-tx))))

29
deps/db/test/logseq/db_test.cljs vendored Normal file
View File

@ -0,0 +1,29 @@
(ns logseq.db-test
(:require [cljs.test :refer [deftest is]]
[logseq.db.frontend.schema :as db-schema]
[datascript.core :as d]
[logseq.db :as ldb]))
;;; datoms
;;; - 1 <----+
;;; - 2 |
;;; - 3 -+
(def broken-outliner-data-with-cycle
[{:db/id 1
:block/uuid #uuid"e538d319-48d4-4a6d-ae70-c03bb55b6fe4"
:block/parent 3}
{:db/id 2
:block/uuid #uuid"c46664c0-ea45-4998-adf0-4c36486bb2e5"
:block/parent 1}
{:db/id 3
:block/uuid #uuid"2b736ac4-fd49-4e04-b00f-48997d2c61a2"
:block/parent 2}])
(deftest get-block-children-ids-on-bad-outliner-data
(let [db (d/db-with (d/empty-db db-schema/schema)
broken-outliner-data-with-cycle)]
(is (= "bad outliner data, need to re-index to fix"
(try (ldb/get-block-children-ids db #uuid "e538d319-48d4-4a6d-ae70-c03bb55b6fe4")
(catch :default e
(ex-message e)))))))

View File

@ -1,29 +1,60 @@
(ns logseq.outliner.pipeline-test
(:require [cljs.test :refer [deftest is]]
(:require [cljs.test :refer [deftest is testing]]
[logseq.db.frontend.schema :as db-schema]
[datascript.core :as d]
[logseq.db :as ldb]))
[logseq.db.sqlite.create-graph :as sqlite-create-graph]
[logseq.db.sqlite.build :as sqlite-build]
[logseq.outliner.db-pipeline :as db-pipeline]
[logseq.outliner.pipeline :as outliner-pipeline]
[clojure.string :as string]))
(defn- get-blocks [db]
(->> (d/q '[:find (pull ?b [* {:block/path-refs [:block/name :db/id]}])
:in $
:where [?b :block/content] [(missing? $ ?b :logseq.property/built-in?)]]
db)
(map first)))
;;; datoms
;;; - 1 <----+
;;; - 2 |
;;; - 3 -+
(def broken-outliner-data-with-cycle
[{:db/id 1
:block/uuid #uuid"e538d319-48d4-4a6d-ae70-c03bb55b6fe4"
:block/parent 3}
{:db/id 2
:block/uuid #uuid"c46664c0-ea45-4998-adf0-4c36486bb2e5"
:block/parent 1}
{:db/id 3
:block/uuid #uuid"2b736ac4-fd49-4e04-b00f-48997d2c61a2"
:block/parent 2}])
(deftest compute-block-path-refs-tx
(testing "when a block's :refs change, descendants of block have correct :block/path-refs"
(let [conn (d/create-conn db-schema/schema-for-db-based-graph)
;; needed in order for path-refs to be setup correctly with init data
_ (db-pipeline/add-listener conn)
_ (d/transact! conn (sqlite-create-graph/build-db-initial-data "{}"))
[parent-uuid child-uuid] (repeatedly 2 random-uuid)
{:keys [init-tx]}
(sqlite-build/build-blocks-tx
{:pages-and-blocks
[{:page {:block/original-name "bar"}}
{:page {:block/original-name "page1"}
:blocks [{:block/content "parent [[foo]]"
:block/uuid parent-uuid}
{:block/content "child [[baz]]"
:block/uuid child-uuid
:block/parent {:db/id [:block/uuid parent-uuid]}}
{:block/content "grandchild [[bing]]"
:block/parent {:db/id [:block/uuid child-uuid]}}]}]})
_ (d/transact! conn init-tx)
blocks (get-blocks @conn)
;; Update parent block to replace 'foo' with 'bar' ref
new-tag-id (ffirst (d/q '[:find ?b :where [?b :block/original-name "bar"]] @conn))
modified-blocks (map #(if (string/starts-with? (:block/content %) "parent")
(assoc %
:block/refs [{:db/id new-tag-id}]
:block/path-refs [{:db/id new-tag-id}])
%)
blocks)
refs-tx (outliner-pipeline/compute-block-path-refs-tx {:db-after @conn} modified-blocks)
_ (d/transact! conn refs-tx {:pipeline-replace? true})
updated-blocks (->> (get-blocks @conn)
;; Only keep enough of content to uniquely identify block
(map #(hash-map :block/content (re-find #"\w+" (:block/content %))
:path-ref-names (set (map :block/name (:block/path-refs %))))))]
(is (= [{:block/content "parent"
:path-ref-names #{"page1" "bar"}}
{:block/content "child"
:path-ref-names #{"page1" "bar" "baz"}}
{:block/content "grandchild"
:path-ref-names #{"page1" "bar" "baz" "bing"}}]
updated-blocks)))))
(deftest get-block-children-ids-on-bad-outliner-data
(let [db (d/db-with (d/empty-db db-schema/schema)
broken-outliner-data-with-cycle)]
(is (= "bad outliner data, need to re-index to fix"
(try (ldb/get-block-children-ids db #uuid "e538d319-48d4-4a6d-ae70-c03bb55b6fe4")
(catch :default e
(ex-message e)))))))

View File

@ -1,27 +1,17 @@
(ns logseq.tasks.db-graph.create-graph
"This ns provides fns to create a DB graph using EDN. See `init-conn` for
initializing a DB graph with a datascript connection that syncs to a sqlite DB
at the given directory. See `create-blocks-tx` for the EDN format to create a
at the given directory. See `build-blocks-tx` for the EDN format to create a
graph and current limitations"
(:require [logseq.db.sqlite.db :as sqlite-db]
[logseq.db.sqlite.util :as sqlite-util]
[logseq.db.sqlite.create-graph :as sqlite-create-graph]
[logseq.db.frontend.property.build :as db-property-build]
[logseq.outliner.db-pipeline :as db-pipeline]
[logseq.common.util :as common-util]
[clojure.string :as string]
[clojure.set :as set]
[datascript.core :as d]
["fs" :as fs]
["path" :as node-path]
[nbb.classpath :as cp]
[logseq.db.frontend.property :as db-property]
[logseq.db.frontend.order :as db-order]
[logseq.db.frontend.property.type :as db-property-type]
[logseq.db.frontend.class :as db-class]
[logseq.db.frontend.db-ident :as db-ident]
[logseq.common.util.page-ref :as page-ref]
[logseq.db.frontend.content :as db-content]))
[logseq.db.sqlite.build :as sqlite-build]))
(defn- find-on-classpath [rel-path]
(some (fn [dir]
@ -54,368 +44,4 @@
(setup-init-data conn additional-config)
conn))
(defn- translate-property-value
"Translates a property value for create-graph edn. A value wrapped in vector
may indicate a reference type e.g. [:page \"some page\"]"
[val page-uuids]
(if (vector? val)
(case (first val)
;; Converts a page name to block/uuid
:page
(if-let [page-uuid (page-uuids (second val))]
[:block/uuid page-uuid]
(throw (ex-info (str "No uuid for page '" (second val) "'") {:name (second val)})))
:block/uuid
val)
val))
(defn- get-ident [all-idents kw]
(or (get all-idents kw)
(throw (ex-info (str "No ident found for " (pr-str kw)) {}))))
(defn- ->block-properties [properties page-uuids all-idents]
(->>
(map
(fn [[prop-name val]]
[(get-ident all-idents prop-name)
;; set indicates a :many value
(if (set? val)
(set (map #(translate-property-value % page-uuids) val))
(translate-property-value val page-uuids))])
properties)
(into {})))
(defn- create-page-uuids
"Creates maps of unique page names, block contents and property names to their uuids"
[pages-and-blocks]
(->> pages-and-blocks
(map :page)
(map (juxt #(or (:block/original-name %) (:block/name %))
:block/uuid))
(into {})))
(def current-db-id (atom 0))
(def new-db-id
"Provides the next temp :db/id to use in a create-graph transact!"
#(swap! current-db-id dec))
(defn- create-property-value
[block property-ident value]
(db-property-build/build-property-value-block
block
property-ident
;; FIXME: Remove when fixed in UI
(str value)))
;; TODO: Use build-property-values-tx-m
(defn- ->property-value-tx-m
"Given a new block and its properties, creates a map of properties which have values of property value tx.
This map is used for both creating the new property values and then adding them to a block"
[new-block properties properties-config all-idents]
(->> properties
(map (fn [[k v]]
(when (and (db-property-type/value-ref-property-types (get-in properties-config [k :block/schema :type]))
;; TODO: Support translate-property-value without this hack
(not (vector? v)))
[k (if (set? v)
(set (map #(create-property-value new-block (get-ident all-idents k) %) v))
(create-property-value new-block (get-ident all-idents k) v))])))
(into {})))
(defn- extract-content-refs
"Extracts basic refs from :block/content like `[[foo]]`. Adding more ref support would
require parsing each block with mldoc and extracting with text/extract-refs-from-mldoc-ast"
[s]
;; FIXME: Better way to ignore refs inside a macro
(if (string/starts-with? s "{{")
[]
(map second (re-seq page-ref/page-ref-re s))))
(defn- ->block-tx [{:keys [properties] :as m} properties-config page-uuids all-idents page-id]
(let [new-block {:db/id (new-db-id)
:block/format :markdown
:block/page {:db/id page-id}
:block/order (db-order/gen-key nil)
:block/parent {:db/id page-id}}
pvalue-tx-m (->property-value-tx-m new-block properties properties-config all-idents)
ref-names (extract-content-refs (:block/content m))]
(cond-> []
;; Place property values first since they are referenced by block
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj (merge (dissoc m :properties)
(sqlite-util/block-with-timestamps new-block)
(when (seq properties)
(->block-properties (merge properties (db-property-build/build-properties-with-ref-values pvalue-tx-m))
page-uuids all-idents))
(when (seq ref-names)
(let [block-refs (mapv #(hash-map :block/uuid
(or (page-uuids %)
(throw (ex-info (str "No uuid for page ref name" (pr-str %)) {})))
:block/original-name %)
ref-names)]
{:block/content (db-content/page-ref->special-id-ref (:block/content m) block-refs)
:block/refs (map #(dissoc % :block/original-name) block-refs)})))))))
(defn- build-properties-tx [properties page-uuids all-idents]
(let [property-db-ids (->> (keys properties)
(map #(vector (name %) (new-db-id)))
(into {}))
new-properties-tx (vec
(mapcat
(fn [[prop-name {:keys [schema-classes] :as prop-m}]]
(if (:closed-values prop-m)
(let [db-ident (get-ident all-idents prop-name)]
(db-property-build/build-closed-values
db-ident
prop-name
(assoc prop-m :db/ident db-ident)
{:property-attributes
{:db/id (or (property-db-ids (name prop-name))
(throw (ex-info "No :db/id for property" {:property prop-name})))}}))
(let [new-block
(merge (sqlite-util/build-new-property (get-ident all-idents prop-name)
(:block/schema prop-m)
{:block-uuid (:block/uuid prop-m)})
{:db/id (or (property-db-ids (name prop-name))
(throw (ex-info "No :db/id for property" {:property prop-name})))})
pvalue-tx-m (->property-value-tx-m new-block (:properties prop-m) properties all-idents)]
(cond-> []
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj
(merge
new-block
(when-let [props (not-empty (:properties prop-m))]
(->block-properties (merge props (db-property-build/build-properties-with-ref-values pvalue-tx-m)) page-uuids all-idents))
(when (seq schema-classes)
{:property/schema.classes
(mapv #(hash-map :db/ident (get-ident all-idents (keyword %)))
schema-classes)})))))))
properties))]
new-properties-tx))
(defn- build-classes-tx [classes properties-config uuid-maps all-idents]
(let [class-db-ids (->> (keys classes)
(map #(vector (name %) (new-db-id)))
(into {}))
classes-tx (vec
(mapcat
(fn [[class-name {:keys [class-parent schema-properties] :as class-m}]]
(let [new-block
(sqlite-util/build-new-class
{:block/name (common-util/page-name-sanity-lc (name class-name))
:block/original-name (name class-name)
:block/uuid (d/squuid)
:db/ident (get-ident all-idents class-name)
:db/id (or (class-db-ids (name class-name))
(throw (ex-info "No :db/id for class" {:class class-name})))})
pvalue-tx-m (->property-value-tx-m new-block (:properties class-m) properties-config all-idents)]
(cond-> []
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj
(merge
new-block
(dissoc class-m :properties :class-parent :schema-properties)
(when-let [props (not-empty (:properties class-m))]
(->block-properties (merge props (db-property-build/build-properties-with-ref-values pvalue-tx-m)) uuid-maps all-idents))
(when class-parent
{:class/parent
(or (class-db-ids class-parent)
(throw (ex-info (str "No :db/id for " class-parent) {})))})
(when schema-properties
{:class/schema.properties
(mapv #(hash-map :db/ident (get-ident all-idents (keyword %)))
schema-properties)}))))))
classes))]
classes-tx))
(defn- validate-options
[{:keys [pages-and-blocks properties classes]}]
(let [page-block-properties (->> pages-and-blocks
(map #(-> (:blocks %) vec (conj (:page %))))
(mapcat #(->> % (map :properties) (mapcat keys)))
set)
property-class-properties (->> (vals properties)
(concat (vals classes))
(mapcat #(keys (:properties %)))
set)
undeclared-properties (-> page-block-properties
(into property-class-properties)
(set/difference (set (keys properties))))
invalid-pages (remove #(or (:block/original-name %) (:block/name %))
(map :page pages-and-blocks))]
(assert (empty? invalid-pages)
(str "The following pages did not have a name attribute: " invalid-pages))
(assert (every? #(get-in % [:block/schema :type]) (vals properties))
"All properties must have :block/schema and :type")
(assert (empty? undeclared-properties)
(str "The following properties used in EDN were not declared in :properties: " undeclared-properties))))
;; TODO: How to detect these idents don't conflict with existing? :db/add?
(defn- create-all-idents
[properties classes graph-namespace]
(let [property-idents (->> (keys properties)
(map #(vector %
(if graph-namespace
(db-ident/create-db-ident-from-name (str (name graph-namespace) ".property")
(name %))
(db-property/create-user-property-ident-from-name (name %)))))
(into {}))
_ (assert (= (count (set (vals property-idents))) (count properties)) "All property db-idents must be unique")
class-idents (->> (keys classes)
(map #(vector %
(if graph-namespace
(db-ident/create-db-ident-from-name (str (name graph-namespace) ".class")
(name %))
(db-class/create-user-class-ident-from-name (name %)))))
(into {}))
_ (assert (= (count (set (vals class-idents))) (count classes)) "All class db-idents must be unique")
all-idents (merge property-idents class-idents)]
(assert (= (count all-idents) (+ (count property-idents) (count class-idents)))
"Class and property db-idents have no overlap")
all-idents))
(defn- build-pages-and-blocks-tx
[pages-and-blocks all-idents page-uuids {:keys [page-id-fn properties]
:or {page-id-fn :db/id}}]
(let [new-pages-from-refs
(->> pages-and-blocks
(mapcat
(fn [{:keys [blocks]}]
(->> blocks
(mapcat #(extract-content-refs (:block/content %)))
(remove page-uuids))))
(map #(hash-map :page {:block/original-name % :block/uuid (random-uuid)})))
pages-and-blocks' (concat pages-and-blocks new-pages-from-refs)
;; TODO: Make page-uuids' available to all fns once pages only take :block/original-name
page-uuids' (into page-uuids (map #(vector (get-in % [:page :block/original-name])
(get-in % [:page :block/uuid]))
new-pages-from-refs))]
(vec
(mapcat
(fn [{:keys [page blocks]}]
(let [new-page (merge
{:db/id (or (:db/id page) (new-db-id))
:block/original-name (or (:block/original-name page) (string/capitalize (:block/name page)))
:block/name (or (:block/name page) (common-util/page-name-sanity-lc (:block/original-name page)))
:block/format :markdown}
(dissoc page :properties :db/id :block/name :block/original-name))
pvalue-tx-m (->property-value-tx-m new-page (:properties page) properties all-idents)]
(into
;; page tx
(cond-> []
(seq pvalue-tx-m)
(into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
true
(conj
(sqlite-util/block-with-timestamps
(merge
new-page
(when (seq (:properties page))
(->block-properties (merge (:properties page) (db-property-build/build-properties-with-ref-values pvalue-tx-m))
page-uuids'
all-idents))))))
;; blocks tx
(reduce (fn [acc m]
(into acc
(->block-tx m properties page-uuids' all-idents (page-id-fn new-page))))
[]
blocks))))
pages-and-blocks'))))
(defn- split-blocks-tx
"Splits a vec of maps tx into maps that can immediately be transacted,
:init-tx, and maps that need to be transacted after :init-tx, :block-props-tx, in order to use
the correct schema e.g. user properties with :db/cardinality"
[blocks-tx]
(let [property-idents (keep #(when (:db/cardinality %) (:db/ident %)) blocks-tx)
[init-tx block-props-tx]
(reduce (fn [[init-tx* block-props-tx*] m]
(let [props (select-keys m property-idents)]
[(conj init-tx* (apply dissoc m property-idents))
(if (seq props)
(conj block-props-tx*
(merge {:block/uuid (or (:block/uuid m)
(throw (ex-info "No :block/uuid for block" {:block m})))}
props))
block-props-tx*)]))
[[] []]
blocks-tx)]
{:init-tx init-tx
:block-props-tx block-props-tx}))
(defn create-blocks-tx
"Given an EDN map for defining pages, blocks and properties, this creates a map
with two keys of transactable data for use with d/transact!. The :init-tx key
must be transacted first and the :block-props-tx can be transacted after.
The blocks that can be created have the following limitations:
* Only top level blocks can be easily defined. Other level blocks can be
defined but they require explicit setting of attributes like :block/order and :block/parent
* Block content containing page refs or tags is not supported yet
The EDN map has the following keys:
* :pages-and-blocks - This is a vector of maps containing a :page key and optionally a :blocks
key when defining a page's blocks. More about each key:
* :page - This is a datascript attribute map e.g. `{:block/name \"foo\"}` .
:block/name is required and :properties can be passed to define page properties
* :blocks - This is a vec of datascript attribute maps e.g. `{:block/content \"bar\"}`.
:block/content is required and :properties can be passed to define block properties
* :properties - This is a map to configure properties where the keys are property name keywords
and the values are maps of datascript attributes e.g. `{:block/schema {:type :checkbox}}`.
Additional keys available:
* :closed-values - Define closed values with a vec of maps. A map contains keys :uuid, :value and :icon.
* :properties - Define properties on a property page.
* :schema-classes - Vec of class names. Defines a property's range classes
* :classes - This is a map to configure classes where the keys are class name keywords
and the values are maps of datascript attributes e.g. `{:block/original-name \"Foo\"}`.
Additional keys available:
* :properties - Define properties on a class page
* :class-parent - Add a class parent by its name
* :schema-properties - Vec of property names. Defines properties that a class gives to its objects
* :graph-namespace - namespace to use for db-ident creation. Useful when importing an ontology
* :page-id-fn - custom fn that returns ent lookup id for page refs e.g. `[:block/uuid X]`
Default is :db/id
The :properties in :pages-and-blocks, :properties and :classes is a map of
property name keywords to property values. Multiple property values for a many
cardinality property are defined as a set. The following property types are
supported: :default, :url, :checkbox, :number, :page and :date. :checkbox and
:number values are written as booleans and integers/floats. :page references
are written as vectors e.g. `[:page \"PAGE NAME\"]`"
[{:keys [pages-and-blocks properties classes graph-namespace]
:as options}]
(let [_ (validate-options options)
;; add uuids before tx for refs in :properties
pages-and-blocks' (mapv (fn [{:keys [page blocks]}]
(cond-> {:page (merge {:block/uuid (random-uuid)} page)}
(seq blocks)
(assoc :blocks (mapv #(merge {:block/uuid (random-uuid)} %) blocks))))
pages-and-blocks)
page-uuids (create-page-uuids pages-and-blocks')
all-idents (create-all-idents properties classes graph-namespace)
properties-tx (build-properties-tx properties page-uuids all-idents)
classes-tx (build-classes-tx classes properties page-uuids all-idents)
class-ident->id (->> classes-tx (map (juxt :db/ident :db/id)) (into {}))
;; Replace idents with db-ids to avoid any upsert issues
properties-tx' (mapv (fn [m]
(if (:property/schema.classes m)
(update m :property/schema.classes
(fn [cs]
(mapv #(or (some->> (:db/ident %) class-ident->id (hash-map :db/id))
(throw (ex-info (str "No :db/id found for :db/ident " (pr-str (:db/ident %))) {})))
cs)))
m))
properties-tx)
pages-and-blocks-tx (build-pages-and-blocks-tx pages-and-blocks' all-idents page-uuids options)]
;; Properties first b/c they have schema and are referenced by all. Then classes b/c they can be referenced by pages. Then pages
(split-blocks-tx (concat properties-tx'
classes-tx
pages-and-blocks-tx))))
(def build-blocks-tx sqlite-build/build-blocks-tx)

View File

@ -66,7 +66,7 @@
((juxt node-path/dirname node-path/basename) graph-dir)
[(node-path/join (os/homedir) "logseq" "graphs") graph-dir])
conn (create-graph/init-conn dir db-name)
{:keys [init-tx block-props-tx]} (create-graph/create-blocks-tx (create-init-data))]
{:keys [init-tx block-props-tx]} (create-graph/build-blocks-tx (create-init-data))]
(println "Generating" (count (filter :block/name init-tx)) "pages and"
(count (filter :block/content init-tx)) "blocks ...")
(d/transact! conn init-tx)

View File

@ -67,7 +67,7 @@
[(node-path/join (os/homedir) "logseq" "graphs") graph-dir])
conn (create-graph/init-conn dir db-name)
_ (println "Building tx ...")
{:keys [init-tx]} (create-graph/create-blocks-tx (create-init-data options))]
{:keys [init-tx]} (create-graph/build-blocks-tx (create-init-data options))]
(println "Built" (count init-tx) "tx," (count (filter :block/original-name init-tx)) "pages and"
(count (filter :block/content init-tx)) "blocks ...")
;; Vary the chunking with page size up to a max to avoid OOM

View File

@ -195,7 +195,7 @@
((juxt node-path/dirname node-path/basename) graph-dir)
[(node-path/join (os/homedir) "logseq" "graphs") graph-dir])
conn (create-graph/init-conn dir db-name {:additional-config (:config options)})
{:keys [init-tx block-props-tx]} (create-graph/create-blocks-tx (create-init-data))
{:keys [init-tx block-props-tx]} (create-graph/build-blocks-tx (create-init-data))
existing-names (set (map :v (d/datoms @conn :avet :block/original-name)))
conflicting-names (set/intersection existing-names (set (keep :block/original-name init-tx)))]
(when (seq conflicting-names)

View File

@ -397,7 +397,7 @@
conn (create-graph/init-conn dir db-name {:additional-config (:config options)})
init-data (create-init-data (d/q '[:find [?name ...] :where [?b :block/name ?name]] @conn)
options)
{:keys [init-tx block-props-tx]} (create-graph/create-blocks-tx init-data)]
{:keys [init-tx block-props-tx]} (create-graph/build-blocks-tx init-data)]
(println "Generating" (str (count (filter :block/name init-tx)) " pages with "
(count (:classes init-data)) " classes and "
(count (:properties init-data)) " properties ..."))

View File

@ -1,47 +0,0 @@
(ns frontend.worker.pipeline-test
(:require [cljs.test :refer [deftest is use-fixtures testing]]
[datascript.core :as d]
[frontend.db :as db]
[frontend.worker.pipeline :as worker-pipeline]
[frontend.test.helper :as test-helper :refer [load-test-files]]))
(use-fixtures :each test-helper/start-and-destroy-db)
(defn- get-blocks [db]
(->> (d/q '[:find (pull ?b [* {:block/path-refs [:block/name :db/id]}])
:in $
:where [?b :block/content] [(missing? $ ?b :block/pre-block?)]]
db)
(map first)))
;; TODO: Move this test to outliner dep when there is a load-test-files helper for deps
(deftest compute-block-path-refs-tx
(load-test-files [{:file/path "pages/page1.md"
:file/content "prop:: #bar
- parent #foo
- child #baz
- grandchild #bing"}])
(testing "when a block's :refs change, descendants of block have correct :block/path-refs"
(let [conn (db/get-db test-helper/test-db false)
blocks (get-blocks @conn)
;; Update parent block to replace #foo with #bar
new-tag-id (:db/id (db/get-page "bar"))
modified-blocks (map #(if (= "parent #foo" (:block/content %))
(assoc %
:block/refs [{:db/id new-tag-id}]
:block/path-refs [{:db/id new-tag-id}])
%)
blocks)
refs-tx (#'worker-pipeline/compute-block-path-refs-tx {:tx-meta {:outliner-op :save-block} :db-after @conn} modified-blocks)
_ (d/transact! conn refs-tx)
updated-blocks (->> (get-blocks @conn)
(map #(hash-map :block/content (:block/content %)
:path-ref-names (mapv :block/name (:block/path-refs %)))))]
(is (= [;; still have old parent content b/c we're only testing :block/path-refs updates
{:block/content "parent #foo"
:path-ref-names ["page1" "bar"]}
{:block/content "child #baz"
:path-ref-names ["page1" "bar" "baz"]}
{:block/content "grandchild #bing"
:path-ref-names ["page1" "bar" "baz" "bing"]}]
updated-blocks)))))