Merge branch 'main' into revert-2270-revert-2266-block-perf-by-view

Author: filipesilva

.carve/ignore

@@ -1,6 +1,5 @@
 athens.db/help-url
 athens.db/ego-url
-athens.events/shared-blocks-excl-date-pages
 athens.views.right-sidebar/sidebar-section-heading-style
 athens.core/init
 athens.main.core/main

CHANGELOG.md

@@ -1,7 +1,7 @@
 {
   "name": "Athens",
   "author": "athensresearch",
-  "version": "2.1.0-beta.2",
+  "version": "2.1.0-beta.3",
   "description": "An open-source knowledege graph for research and notetaking",
   "repository": {
     "type": "git",

package.json

@@ -642,7 +642,7 @@
     txs))
 
 
-(defn- dissoc-on-match
+(defn dissoc-on-match
   [m [k f]]
   (if (f m)
     (dissoc m k)

src/cljc/athens/common_db.cljc

@@ -128,6 +128,9 @@
   "Convert internal representation to the vector of atomic operations that would create it.
   :block/save operations are grouped at the end so that any ref'd entities are already created."
   [db internal-representation default-position]
+  (when-not (or (vector? internal-representation)
+                (list? internal-representation))
+    (throw "Internal representation must be a vector"))
   (->> internal-representation
        add-missing-block-uids
        enhance-internal-representation

src/cljc/athens/common_events/bfs.cljc

@@ -310,34 +310,69 @@
     [removed-links added-links]))
 
 
+(defn throw-unknown-k
+  [k]
+  (throw (str "Key " k " must be either string or ::first/::last.")))
+
+
 (defn- new-prop
-  [db [a v :as uid-or-eid] prop-uid k]
+  [db [a v :as uid-or-eid] next-uid k]
   (let [uid?     (-> uid-or-eid vector? not)
         uid      (if uid?
                    uid-or-eid
                    (common-db/get-block-uid db uid-or-eid))
         title    (or (common-db/get-page-title db uid)
                      (and (= a :node/title) v))
-        position (merge {:relation {:page/title k}}
+        ;; here too
+        position (merge {:relation (cond
+                                     (= ::first k) :first
+                                     (= ::last k)  :last
+                                     (string? k)   {:page/title k}
+                                     :else         (throw-unknown-k k))}
                         (if title
                           {:page/title title}
                           {:block/uid uid}))]
-    (build-block-new-op db prop-uid position)))
+    (build-block-new-op db next-uid position)))
 
 
-(defn build-property-path
+(defn build-path
+  "Return uid at ks path and operations to create path, if needed, as [uid ops].
+  uid can be a string or a datascript eid.
+  ks can be properties names as strings, or ::first/::last for children."
   ([db uid ks]
-   (build-property-path db uid ks []))
+   (build-path db uid ks []))
   ([db uid-or-eid [k & ks] ops]
    (if-not k
      [uid-or-eid ops]
      (let [uid?       (-> uid-or-eid vector? not)
            block      (common-db/get-block db (if uid?
                                                 [:block/uid uid-or-eid]
                                                 uid-or-eid))
-           prop-block (-> block :block/properties (get k))
-           prop-uid   (or (:block/uid prop-block)
+           next-block (cond
+                        (= ::first k) (-> block :block/children first)
+                        (= ::last k)  (-> block :block/children last)
+                        (string? k)   (-> block :block/properties (get k))
+                        :else         (throw-unknown-k k))
+           next-uid   (or (:block/uid next-block)
                           (common.utils/gen-block-uid))
            ops'       (cond-> ops
-                        (not prop-block) (conj (new-prop db uid-or-eid prop-uid k)))]
-       (recur db prop-uid ks ops')))))
+                        (not next-block) (conj (new-prop db uid-or-eid next-uid k)))]
+       (recur db next-uid ks ops')))))
+
+
+(defn get-path
+  "Return uid at ks path."
+  [db uid-or-eid [k & ks]]
+  (if-not (and uid-or-eid k)
+    uid-or-eid
+    (let [uid?       (-> uid-or-eid vector? not)
+          block      (common-db/get-block db (if uid?
+                                               [:block/uid uid-or-eid]
+                                               uid-or-eid))
+          next-block (cond
+                       (= ::first k) (-> block :block/children first)
+                       (= ::last k)  (-> block :block/children last)
+                       (string? k)   (-> block :block/properties (get k))
+                       :else         (throw-unknown-k k))
+          next-uid   (:block/uid next-block)]
+      (recur db next-uid ks))))

src/cljc/athens/common_events/graph/ops.cljc

@@ -18,17 +18,22 @@
 
 (defmethod resolve-atomic-op-to-tx :block/new
   [db {:op/keys [args]} event-ref]
-  (let [{:block/keys [uid position]} args
-        new-block                    {:block/uid    uid
-                                      :block/string ""
-                                      :block/open   true
-                                      :block/create event-ref
-                                      :block/edits  event-ref}
-        position-tx                  (condp = (position/position-type position)
-                                       :child    (position/add-child db uid position event-ref)
-                                       :property (position/add-property db uid position event-ref))
-        tx-data                      (into [new-block] position-tx)]
-    tx-data))
+  (let [{:block/keys [uid position]} args]
+    (if (common-db/block-exists? db [:block/uid uid])
+      ;; Treast :block/new on an existing block as a :block/move instead.
+      (resolve-atomic-op-to-tx db {:op/type :block/move
+                                   :op/args args}
+                               event-ref)
+      (let [new-block   {:block/uid    uid
+                         :block/string ""
+                         :block/open   true
+                         :block/create event-ref
+                         :block/edits  event-ref}
+            position-tx (condp = (position/position-type position)
+                          :child    (position/add-child db uid position event-ref)
+                          :property (position/add-property db uid position event-ref))
+            tx-data     (into [new-block] position-tx)]
+        tx-data))))
 
 
 ;; This is Atomic Graph Op, there is also composite version of it
@@ -78,8 +83,8 @@
                                        (if same-parent?
                                          (position/move-child-within
                                            db old-parent-uid uid position event-ref)
-                                         (position/move-child-between
-                                           db old-parent-uid new-parent-uid uid position event-ref))
+                                         (concat (position/remove-child db uid old-parent-uid event-ref)
+                                                 (position/add-child db uid position event-ref)))
 
                                        [:child :property]
                                        (concat

src/cljc/athens/common_events/resolver/atomic.cljc

@@ -53,14 +53,6 @@
       :else v)))
 
 
-(defn move-between
-  "Move x from origin to destination, to a position defined by relation to target.
-  See athens.common-events.graph.schema for position values.
-  Returns [modified-origin modified-destination]."
-  [origin destination x relation target]
-  [(remove origin x) (insert destination x relation target)])
-
-
 (defn move-within
   "Move x within v, to a position defined by relation to target.
   See athens.common-events.graph.schema for position values.

src/cljc/athens/common_events/resolver/order.cljc

@@ -47,25 +47,6 @@
     (concat reorder edit)))
 
 
-(defn move-child-between
-  [db old-parent-uid new-parent-uid uid position event-ref]
-  (let [{:keys [relation]}      position
-        [ref-uid]               (common-db/position->uid+parent db position)
-        origin-children         (common-db/get-children-uids db [:block/uid old-parent-uid])
-        destination-children    (common-db/get-children-uids db [:block/uid new-parent-uid])
-        [origin-children'
-         destination-children'] (order/move-between origin-children destination-children uid relation ref-uid)
-        reorder-origin          (order/reorder origin-children origin-children' order/block-map-fn)
-        reorder-destination     (order/reorder destination-children destination-children' order/block-map-fn)
-        update-parent           [[:db/retract [:block/uid old-parent-uid] :block/children [:block/uid uid]]
-                                 {:block/uid   old-parent-uid
-                                  :block/edits event-ref}
-                                 {:block/uid      new-parent-uid
-                                  :block/children [{:block/uid uid}]
-                                  :block/edits    event-ref}]]
-    (concat reorder-origin reorder-destination update-parent)))
-
-
 (defn add-property
   "Add uid as property under position. Transaction will fail if a property for position already exists."
   [db uid position event-ref]

src/cljc/athens/common_events/resolver/position.cljc

@@ -252,43 +252,6 @@
   (-> (d/datoms @dsdb :eavt e a) first :v))
 
 
-(def rules
-  '[[(after ?p ?at ?ch ?o)
-     [?p :block/children ?ch]
-     [?ch :block/order ?o]
-     [(> ?o ?at)]]
-    [(between ?p ?lower-bound ?upper-bound ?ch ?o)
-     [?p :block/children ?ch]
-     [?ch :block/order ?o]
-     [(> ?o ?lower-bound)]
-     [(< ?o ?upper-bound)]]
-    [(inc-after ?p ?at ?ch ?new-o)
-     (after ?p ?at ?ch ?o)
-     [(inc ?o) ?new-o]]
-    [(dec-after ?p ?at ?ch ?new-o)
-     (after ?p ?at ?ch ?o)
-     [(dec ?o) ?new-o]]
-    [(plus-after ?p ?at ?ch ?new-o ?x)
-     (after ?p ?at ?ch ?o)
-     [(+ ?o ?x) ?new-o]]
-    [(minus-after ?p ?at ?ch ?new-o ?x)
-     (after ?p ?at ?ch ?o)
-     [(- ?o ?x) ?new-o]]
-    [(siblings ?uid ?sib-e)
-     [?e :block/uid ?uid]
-     [?p :block/children ?e]
-     [?p :block/children ?sib-e]]])
-
-
-(defn inc-after
-  [eid order]
-  (->> (d/q '[:find ?ch ?new-o
-              :keys db/id block/order
-              :in $ % ?p ?at
-              :where (inc-after ?p ?at ?ch ?new-o)]
-            @dsdb rules eid order)))
-
-
 (defn uid-and-embed-id
   [uid]
   (or (some->> uid
@@ -305,32 +268,6 @@
     block))
 
 
-(def block-document-pull-vector
-  '[:db/id :block/uid :block/string :block/open :block/order {:block/children ...} :block/refs :block/_refs])
-
-
-(def node-document-pull-vector
-  (-> block-document-pull-vector
-      (conj :node/title :page/sidebar)))
-
-
-(def roam-node-document-pull-vector
-  '[:node/title :block/uid :block/string :block/open :block/order {:block/children ...}])
-
-
-(defntrace get-node-document
-  [id db]
-  (when (d/entity db id)
-    (->> (d/pull db node-document-pull-vector id)
-         sort-block-children)))
-
-
-(defntrace get-roam-node-document
-  [id db]
-  (->> (d/pull db roam-node-document-pull-vector id)
-       sort-block-children))
-
-
 (defntrace shape-parent-query
   "Normalize path from deeply nested block to root node."
   [pull-results]