From 54c57e085aa99f4e305cc73e4435bb1b0daa5171 Mon Sep 17 00:00:00 2001 From: arne Date: Sat, 22 Nov 2025 09:04:06 +0100 Subject: [PATCH 1/2] Add mechanism for data migrations --- src/computersandblues/lodestone/app.cljs | 56 +++++++++++-------- src/computersandblues/lodestone/database.cljs | 31 +++++++--- src/computersandblues/lodestone/interop.cljs | 39 +++++++++++++ .../lodestone/interop_test.cljs | 43 ++++++++++++++ 4 files changed, 137 insertions(+), 32 deletions(-) create mode 100644 src/computersandblues/lodestone/interop.cljs create mode 100644 src/computersandblues/lodestone/interop_test.cljs diff --git a/src/computersandblues/lodestone/app.cljs b/src/computersandblues/lodestone/app.cljs index 50464dd..be39b8a 100644 --- a/src/computersandblues/lodestone/app.cljs +++ b/src/computersandblues/lodestone/app.cljs @@ -4,6 +4,7 @@ [clojure.string :as str] [clojure.pprint :as pprint] [computersandblues.lodestone.database :as db] + [computersandblues.lodestone.interop :refer [promise-all promise-resolve promise-reject]] [computersandblues.lodestone.match :refer [query->matching-xform]] [applied-science.js-interop :as j])) @@ -34,15 +35,6 @@ ;; Mastodon API helpers -(defn- promise-all [xs] - (js/Promise.all (apply array xs))) - -(defn- promise-resolve [val] - (js/Promise.resolve val)) - -(defn- promise-reject [val] - (js/Promise.reject val)) - (defn- now [] (js/Date.now)) @@ -560,26 +552,45 @@ ;; database -(def db-version 3) +;;; we provide two different kinds of migrations +;;; +;;; - structural migrations +;;; - data migrations +;;; +;;; this is necessary due to the constraints imposed on us by indexeddb. +;;; +;;; structural migrations run in a callback after opening the database. they run +;;; synchronously and do things like creates stores and indices. because they run +;;; synchronously, they cannot modify any of the stored data. +;;; +;;; data migrations can do that! they run after all structural migrations for +;;; the current database version have succeeded, and work on the open database. +;;; +;;; note that for each db-version, there needs to be at least one structural or +;;; data migration. it is fine to have both for a single version, in which case +;;; the structural migration will run first. -(def migrations - {1 (fn migration-0001 [db _] +(def db-version 4) + +(def structural-migrations + {1 (fn =0001-create-stores [db _] (db/create-object-store! db ::db/application {:keyPath "id"}) (db/create-object-store! db ::db/posts {:keyPath "id"})) - 2 (fn migration-0002 [_ txn] + 2 (fn =0002-add-post-created-at-idx [_ txn] (-> (db/open-store txn ::db/posts "readwrite") (db/create-index! ::db/post-created-at "created_at" {:unique false}))) - 3 (fn migration-0003 [_ txn] + 3 (fn =0003-add-post-internal-id-idx [_ txn] (-> (db/open-store txn ::db/posts "readwrite") (db/create-index! ::db/post-internal-id "internal_id" {:unique false})))}) -(defn- convert-internal-ids! [] - ; TODO figure out when we can remove this again - (let [cursor (db/open-cursor ::db/posts ::db/all) - result (db/transduce-cursor (filter (comp string? (j/get :internal_id))) cursor)] - (.then result (fn [rows] - (doseq [row rows] - (db/put! ::db/posts (j/update! row :internal_id parse-long))))))) +(def data-migrations + {4 (fn =0004-convert-internal-ids [db] + (let [cursor (db/open-cursor db ::db/posts ::db/post-internal-id ::db/all) + result (db/transduce-cursor (filter (comp string? (j/get :internal_id))) cursor)] + (.then result + (fn [rows] + (promise-all (for [row rows] + (db/put! ::db/posts (j/update! row :internal_id parse-long))))))))}) ;; go go go @@ -589,8 +600,7 @@ (defn init [] (swap! state assoc :root (rd/create-root (js/document.querySelector "#root"))) (render) - (-> (db/setup! ::database db-version migrations) + (-> (db/setup! ::database db-version structural-migrations data-migrations) (.then #(setup-application!)) - (.then #(convert-internal-ids!)) (.catch (fn [err] (js/console.error ::db/setup! err))))) diff --git a/src/computersandblues/lodestone/database.cljs b/src/computersandblues/lodestone/database.cljs index fba2868..9c57f7a 100644 --- a/src/computersandblues/lodestone/database.cljs +++ b/src/computersandblues/lodestone/database.cljs @@ -1,11 +1,14 @@ (ns computersandblues.lodestone.database - (:refer-clojure :exclude [count get])) + (:refer-clojure :exclude [count get]) + (:require [computersandblues.lodestone.interop :refer [promise-seq]])) (defonce +db+ (atom nil)) -(defn setup! [namespace db-version migrations] - (assert (some? (migrations db-version)) "Will not increase db version as no migration is found") - (let [request (js/indexedDB.open (str namespace) db-version)] +(defn setup! [namespace db-version migrations data-migrations] + (assert (some? (or (migrations db-version) (data-migrations db-version))) + "Will not increase db version as no matching migration is found") + (let [request (js/indexedDB.open (str namespace) db-version) + outstanding-data-migrations (volatile! [])] (js/Promise. (fn [resolve reject] (doto request @@ -17,8 +20,10 @@ (fn [] (.. request -result close) (js/alert "Database is outdated! Please reload the browser window."))) - (reset! +db+ db) - (resolve @+db+ ev)))) + (. (promise-seq @outstanding-data-migrations) + (then (fn [_] + (reset! +db+ db) + (resolve @+db+ ev))))))) (.addEventListener "upgradeneeded" (fn [ev] (let [db (.-result request) @@ -26,9 +31,17 @@ txn (-> ev .-target .-transaction)] (js/console.log ::upgradeneeded ev db) (doseq [version (range (inc old-version) (inc db-version)) - :let [migration (migrations version)]] - (migration db txn))))) - ; we don't add a listener for "blocked" events because we handle "versionchange" above + :let [migration (migrations version)] + :when migration] + (migration db txn)) + (vreset! outstanding-data-migrations + (for [version (range (inc old-version) (inc db-version)) + :let [migration (data-migrations version)] + :when migration] + ; we're not passing `txn` because it has already finished + ; by the time this migration is run + (migration db)))))) + ; we don't add a listener for "blocked" events because we handle "versionchange" above (.addEventListener "error" (fn [ev] (reject (.-result request) ev)))))))) (def transaction? (partial instance? js/IDBTransaction)) diff --git a/src/computersandblues/lodestone/interop.cljs b/src/computersandblues/lodestone/interop.cljs new file mode 100644 index 0000000..46ff82d --- /dev/null +++ b/src/computersandblues/lodestone/interop.cljs @@ -0,0 +1,39 @@ +(ns computersandblues.lodestone.interop) + +(defn promise-all [promises] + (js/Promise.all (into-array promises))) + +(reduce (fn [a b] + [a b]) [:foo]) + +(defn promise-seq + "Takes a sequence of promises, and runs them all. This is similar to + `js/Promise.all`, but if any of the promises passed is wrapped in a function, + it will be executed. This allows ordered and delayed execution of a sequence + of promises. " + [promises] + (js/Promise. (fn [resolve _] + (let [results (volatile! (transient []))] + (cond + (and (seq promises) (> (count promises) 2)) + (. (reduce (fn [current next] + (.then current + (fn [res] + (vswap! results conj! res) + (if (fn? next) (next) next)))) + promises) + (then (fn [res] + (vswap! results conj! res) + (resolve (persistent! @results))))) + + (seq promises) + (. (first promises) + (then resolve)) + + :else (resolve [])))))) + +(defn promise-resolve [val] + (js/Promise.resolve val)) + +(defn promise-reject [val] + (js/Promise.reject val)) diff --git a/src/computersandblues/lodestone/interop_test.cljs b/src/computersandblues/lodestone/interop_test.cljs new file mode 100644 index 0000000..e95a851 --- /dev/null +++ b/src/computersandblues/lodestone/interop_test.cljs @@ -0,0 +1,43 @@ +(ns computersandblues.lodestone.interop-test + (:require [computersandblues.lodestone.interop :as sut] + [cljs.test :refer-macros [deftest testing is async]])) + +(deftest promise-seq-empty + (testing "should invoke the callback when passed seq of promises is empty" + (async done (. (sut/promise-seq []) (then done))))) + +(deftest promise-seq-single-element + (testing "should invoke the callback when passed seq contains only a single element" + (async done (. (sut/promise-seq [(sut/promise-resolve true)]) (then done))))) + +(deftest promise-seq-order + (testing "should keep promise order" + (async done + (. (sut/promise-seq (map sut/promise-resolve (range 10))) + (then (fn [result] + (is (= (vec (range 10)) result)) + (done))))))) + +(deftest promise-seq-lazyness + (testing "should invoke functions when passes as promise promise order" + (async done + (. (sut/promise-seq [(sut/promise-resolve :a) + (fn [] :b) + (fn [] (sut/promise-resolve :c))]) + (then (fn [result] + (is (= [:a :b :c] result)) + (done))))))) + +(deftest promise-seq-in-sequence + (testing "should invoke all promises in sequence" + (async done + ; we create a range of promises that all resolve within the same timeout, + ; but because we're wrapping them in a function they will only get created + ; once the sequence has processed far enough + (. (sut/promise-seq (map (fn [_] + (js/Promise. (fn [resolve _] + (js/setTimeout #(resolve (js/Date.now)) 10)))) + (range 5))) + (then (fn [result] + (is (true? (reduce < result))) + (done))))))) From 47d255a3e8b25ef242c31a044e64ff8b5e673e5e Mon Sep 17 00:00:00 2001 From: arne Date: Sat, 22 Nov 2025 09:22:06 +0100 Subject: [PATCH 2/2] Add more advanced filtering methods --- src/computersandblues/lodestone/app.cljs | 15 +++++--- src/computersandblues/lodestone/match.cljs | 41 +++++++++++++++++++--- 2 files changed, 48 insertions(+), 8 deletions(-) diff --git a/src/computersandblues/lodestone/app.cljs b/src/computersandblues/lodestone/app.cljs index be39b8a..792a70f 100644 --- a/src/computersandblues/lodestone/app.cljs +++ b/src/computersandblues/lodestone/app.cljs @@ -294,9 +294,11 @@ :direction :desc}) refresh-id (now)] (swap! state update-in [:section/posts :loading] conj refresh-id) + (js/console.log :start-query (.toISOString (js/Date.))) (. (promise-all [(db/count ::db/posts) (db/transduce-cursor xform posts-cursor)]) (then (fn [[total displayed-posts]] + (js/console.log :end-query (.toISOString (js/Date.))) (swap! state update :section/posts #(-> (assoc % :total total) (assoc :displayed-posts displayed-posts) (update :loading disj refresh-id)))))))) @@ -382,20 +384,25 @@ (comment ; query current results - (-> @state :section/posts :displayed-posts) + (->> (-> @state :section/posts :displayed-posts) (map :id) (take 4) (into #{})) ; run and time a query on the database (do (js/console.log :start (.toISOString (js/Date.))) - (let [xform (comp (mapcat (j/get :tags)) + (let [xform (comp #_(mapcat (j/get :tags)) #_(filter #(= "typescript" (j/get % :name))) - (take 10)) + #_(take 10) + (filter (fn [_] + (< (rand) 0.1)) #_(comp #{"115534300206096276"} (j/get :id))) + (map (j/get :id))) posts-cursor (db/open-cursor ::db/posts ::db/all)] (.. (db/transduce-cursor xform conj! (transient #{}) posts-cursor) (then persistent!) (then (fn [result] (js/console.log :end (.toISOString (js/Date.))) - (js/console.log :accts result)))))) + (let [result (into (sorted-set) result)] + (js/console.log :sorted (.toISOString (js/Date.))) + (js/console.log :accts (count result)))))))) ) (defn post [{:keys [post]}] diff --git a/src/computersandblues/lodestone/match.cljs b/src/computersandblues/lodestone/match.cljs index d675d36..799e863 100644 --- a/src/computersandblues/lodestone/match.cljs +++ b/src/computersandblues/lodestone/match.cljs @@ -1,5 +1,6 @@ (ns computersandblues.lodestone.match - (:require [applied-science.js-interop :as j])) + (:require [applied-science.js-interop :as j] + [clojure.string :as str])) (defn- ->regex "Does its best to compila a stirng into a regular expression; will fall back @@ -14,17 +15,49 @@ (->> (re-seq #"\"([^\"]+)\"|([^\s]+)" query) (mapv (fn [[_ a b]] (or a b))))) -(defn text-matcher [token] - (let [match? (partial re-find (->regex token))] +;; TODO document more advanced matching for users + +(defn text-matcher [term] + (let [match? (partial re-find (->regex term))] (filter (fn [post] (or (match? (j/get post :content)) (match? (j/get-in post [:account :acct])) ; search for url + username of poster (some #(match? (j/get % :username)) (j/get post :mentions)) (some #(some-> (j/get % :description) match?) (j/get post :media_attachments))))))) ; search in alt text +(defn body-matcher [term] + (let [match? (partial re-find (->regex term))] + (filter (fn [post] + (or (match? (j/get post :content)) ; search in post body + (some #(some-> (j/get % :description) match?) (j/get post :media_attachments))))))) ; search in descriptions of attachments + +(defn from-matcher [term] + (filter (fn [post] + (str/starts-with? (j/get-in post [:account :acct]) term)))) + +(defn mention-matcher [term] + (filter (fn [post] + (some #(str/starts-with? (j/get % :username) term) (j/get post :mentions))))) + +(defn date-before-matcher [term] + (filter #(< (j/get % :created_at) term))) + +(defn date-after-matcher [term] + (filter #(> (j/get % :created_at) term))) + +(defn token->term [token] + (str/replace token #"^\w+:" "")) + (defn query->matching-xform [query] (if query (->> (query->tokens query) - (mapv #(text-matcher %)) + (mapv (fn [token] + (cond + (str/starts-with? token "body:") (body-matcher (token->term token)) + (str/starts-with? token "from:") (from-matcher (token->term token)) + (str/starts-with? token "to:") (mention-matcher (token->term token)) + (str/starts-with? token "before:") (date-before-matcher (token->term token)) + (str/starts-with? token "after:") (date-after-matcher (token->term token)) + :else (text-matcher token)))) (reduce comp)) (filter (constantly true))))