listen ds tx-report to generate page related ops

src/main/frontend/db/listener.cljs

@@ -8,7 +8,8 @@
             [promesa.core :as p]
             [electron.ipc :as ipc]
             [datascript.core :as d]
-            [frontend.config :as config]))
+            [frontend.config :as config]
+            [frontend.db.rtc.db-listener :as rtc-db-listener]))
 
 ;; persisting DBs between page reloads
 (defn persist! [repo]
@@ -70,4 +71,6 @@
   [repo]
   (when-let [conn (conn/get-db repo false)]
     (d/unlisten! conn :persistence)
-    (repo-listen-to-tx! repo conn)))
+    (repo-listen-to-tx! repo conn)
+    (d/unlisten! conn :gen-ops)
+    (rtc-db-listener/listen-db-to-generate-ops repo conn)))

src/main/frontend/db/rtc/core.cljs

@@ -56,8 +56,6 @@
        [:parents [:sequential :string]]
        [:left [:maybe :string]]
        [:self :string]
-       [:first-child [:maybe :string]]
-       [:sibling [:maybe :string]]
        [:content {:optional true} :string]]
       [:map
        [:op [:= "remove"]]
@@ -67,8 +65,6 @@
        [:parents [:sequential :string]]
        [:left [:maybe :string]]
        [:self :string]
-       [:first-child [:maybe :string]]
-       [:sibling [:maybe :string]]
        [:content {:optional true} :string]]]]]])
 (def data-from-ws-validator (m/validator data-from-ws-schema))
 
@@ -110,7 +106,10 @@
               (outliner-tx/transact!
                {:persist-op? false}
                (if move?
-                 (outliner-core/move-blocks! [b] local-left true)
+                 (do (outliner-core/move-blocks! [b] local-left true)
+                     (when (and content (not= (:block/content b) content))
+                       (outliner-core/save-block! (assoc (db/pull repo '[*] [:block/uuid (uuid block-uuid-str)])
+                                                         :block/content content))))
                  (outliner-core/insert-blocks! [{:block/uuid (uuid block-uuid-str) :block/content content :block/format :markdown}]
                                                local-left {:sibling? true :keep-uuid? true})))))
 
@@ -120,7 +119,10 @@
                 (outliner-tx/transact!
                  {:persist-op? false}
                  (if move?
-                   (outliner-core/move-blocks! [b] local-left sibling?)
+                   (do (outliner-core/move-blocks! [b] local-left sibling?)
+                       (when (and content (not= (:block/content b) content))
+                         (outliner-core/save-block! (assoc (db/pull repo '[*] [:block/uuid (uuid block-uuid-str)])
+                                                           :block/content content))))
                    (outliner-core/insert-blocks! [{:block/uuid (uuid block-uuid-str) :block/content content
                                                    :block/format :markdown}]
                                                  local-left {:sibling? sibling? :keep-uuid? true}))))))
@@ -130,7 +132,10 @@
               (outliner-tx/transact!
                {:persist-op? false}
                (if move?
-                 (outliner-core/move-blocks! [b] local-parent false)
+                 (do (outliner-core/move-blocks! [b] local-parent false)
+                     (when (and content (not= (:block/content b) content))
+                       (outliner-core/save-block! (assoc (db/pull repo '[*] [:block/uuid (uuid block-uuid-str)])
+                                                         :block/content content))))
                  (outliner-core/insert-blocks! [{:block/uuid (uuid block-uuid-str) :block/content content
                                                  :block/format :markdown}]
                                                local-parent {:sibling? false :keep-uuid? true}))))
@@ -391,7 +396,7 @@
       (init-state ws data-from-ws-chan user-uuid))))
 
 (defonce debug-state (atom nil))
-(defonce debug-graph-uuid "ed4520d5-7985-49bd-a2d7-cf28694e4f03")
+(def debug-graph-uuid "6478874f-20a7-4335-9379-4cfb1cfa1b25")
 (defn ^:export debug-init
   []
   (go
@@ -410,6 +415,12 @@
     (let [state (<! (<init))]
       (<! (full-upload-download-graph/<download-graph state repo graph-uuid)))))
 
+(defn ^:export upload-graph
+  []
+  (go
+    (let [state (<! (<init))]
+      (<! (full-upload-download-graph/<upload-graph state)))))
+
 (defn ^:export debug-client-push-updates
   []
   (async/put! (:client-op-update-chan @debug-state) true))
@@ -417,6 +428,6 @@
 (comment
   (go
     (def global-state (<! (<init))))
-  (reset! (:*graph-uuid global-state) "ed4520d5-7985-49bd-a2d7-cf28694e4f03")
+  (reset! (:*graph-uuid global-state) debug-graph-uuid)
   (reset! (:*repo global-state) (state/get-current-repo))
   )

src/main/frontend/db/rtc/db_listener.cljs

@@ -0,0 +1,93 @@
+(ns frontend.db.rtc.db-listener
+  "listen datascript changes, infer operations from the db tx-report"
+  (:require [datascript.core :as d]
+            [frontend.db :as db]
+            [frontend.db.rtc.op :as op]
+            [frontend.util :as util]))
+
+
+
+(defn- gen-block-ops
+  [repo same-entity-datoms]
+  (when (seq same-entity-datoms)
+    (let [ops (reduce (fn [r [_e a v _t add?]]
+                        (cond
+                          (and add? (contains? #{:block/left :block/parent} a))
+                          (conj r :move)
+
+                          (and (not add?) (contains? #{:block/content} a))
+                          (conj r :update)
+
+                          (and (not add?) (= :block/uuid a))
+                          (reduced #{{:remove v}})
+
+                          :else r))
+                      #{} same-entity-datoms)]
+      (when (seq ops)
+        (if-let [removed-block-uuid (:remove (first ops))]
+          [["remove" {:block-uuids [(str removed-block-uuid)]}]]
+          (let [e (ffirst same-entity-datoms)]
+            (when-let [block-uuid (:block/uuid (db/entity repo e))]
+              (mapv (fn [op]
+                      (case op
+                        :move ["move" {:block-uuid (str block-uuid)}]
+                        :update ["update" {:block-uuid (str block-uuid)}])) ops))))))))
+
+(defn- gen-page-ops
+  [repo same-entity-datoms]
+  (let [r (reduce (fn [r [_e a v _t add?]]
+                    (cond
+                      (and (= a :block/uuid) add?)
+                      (reduced (assoc r :block/uuid v))
+
+                      (and (= a :block/name) add?)
+                      (assoc r :block/name v)
+
+                      (and (= a :block/uuid) (not add?))
+                      (assoc r :block/uuid v :remove? true)
+
+                      :else r))
+                  {:block/name nil :block/uuid nil :remove? false}
+                  same-entity-datoms)
+        block-uuid (or (:block/uuid r)
+                       (and (:block/name r)
+                            (:block/uuid (db/entity repo [:block/name (:block/name r)]))))]
+    (when block-uuid
+      (if (:remove? r)
+        [["remove-page" {:block-uuid (str block-uuid)}]]
+        [["update-page" {:block-uuid (str block-uuid)}]]
+        ))))
+
+(defn dispatch-gen-ops-handler
+  [repo datoms]
+  (let [same-entity-datoms-coll (->> datoms
+                                     (map vec)
+                                     (group-by first)
+                                     vals)
+        ops
+        (loop [ops-coll []
+               [same-entity-datoms & same-entity-datoms-coll*] same-entity-datoms-coll]
+          (if-not same-entity-datoms
+            (apply concat ops-coll)
+            (let [ops (loop [[datom & others] same-entity-datoms]
+                        (when-let [[_e a _v _t _add?] datom]
+                          (cond
+                            (contains? #{:block/parent :block/left :block/content} a)
+                            (gen-block-ops repo same-entity-datoms)
+
+                            (contains? #{:block/name} a)
+                            (gen-page-ops repo same-entity-datoms)
+
+                            :else
+                            (recur others))))]
+              (recur (conj ops-coll ops) same-entity-datoms-coll*))))]
+    (prn :ops ops)
+    ))
+
+
+(defn listen-db-to-generate-ops
+  [repo conn]
+  (d/listen! conn :gen-ops
+             (fn [{:keys [tx-data tx-meta]}]
+               (when (:persist-op? tx-meta true)
+                 (dispatch-gen-ops-handler repo tx-data)))))

src/main/frontend/db/rtc/op.cljs

@@ -13,6 +13,12 @@
     [:value [:map [:block-uuids [:sequential :string]]]]]
    [:catn
     [:op [:= "update"]]
+    [:value [:map [:block-uuid :string]]]]
+   [:catn
+    [:op [:= "update-page"]]
+    [:value [:map [:block-uuid :string]]]]
+   [:catn
+    [:op [:= "remove-page"]]
     [:value [:map [:block-uuid :string]]]]])
 
 (def op-validator (m/validator op-schema))
@@ -35,6 +41,11 @@
     (assert (op-validator op) op)
     (op-store/<add-op! repo op)))
 
+(defn <add-ops!
+  [repo ops]
+  (assert (every? op-validator ops) ops)
+  (op-store/<add-ops! repo ops))
+
 (defn <get-ops&local-tx
   [repo]
   (p/let [all-data (op-store/<get-all-ops repo)]

src/main/frontend/db/rtc/ops_idb_store.cljs

@@ -34,6 +34,26 @@
           (p/recur (inc key*))
           (idb-keyval/set key* (clj->js op) store))))))
 
+(defn- <add-ops*!
+  [repo ops]
+  (let [store (ensure-store repo)
+        key* (tc/to-long (t/now))]
+    (p/loop [key* key* ops ops]
+      (let [[op & other-ops] ops]
+        (when op
+          (p/let [old-v (idb-keyval/get key* store)]
+            (if old-v
+              (p/recur (inc key*) ops)
+              (do (idb-keyval/set key* (clj->js op) store)
+                  (p/recur (inc key*) other-ops)))))))))
+
+(def ^:private add-ops-ch (async/chan 100))
+(async/go-loop []
+  (if-let [[repo ops] (async/<! add-ops-ch)]
+    (do (prn :add-ops ops)
+        (async/<! (p->c (<add-ops*! repo ops)))
+        (recur))
+    (recur)))
 
 (def ^:private add-op-ch (async/chan 100))
 (async/go-loop []
@@ -47,6 +67,11 @@
   [repo op]
   (async/go (async/>! add-op-ch [repo op])))
 
+
+(defn <add-ops!
+  [repo ops]
+  (async/go (async/>! add-ops-ch [repo ops])))
+
 (defn <clear-ops!
   [repo keys]
   (let [store (ensure-store repo)]