Add more advanced filtering methods

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))
 
@@ -302,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))))))))
@@ -390,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]}]
@@ -560,26 +559,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)
+(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]
-                    (doseq [row rows]
-                      (db/put! ::db/posts (j/update! row :internal_id parse-long)))))))
+         (.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 +607,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)))))

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.")))
+                                (. (promise-seq @outstanding-data-migrations)
+                                   (then (fn [_]
                                            (reset! +db+ db)
-                                (resolve @+db+ ev))))
+                                           (resolve @+db+ ev)))))))
          (.addEventListener "upgradeneeded"
                             (fn [ev]
                               (let [db (.-result request)
@@ -26,8 +31,16 @@
                                     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)))))
+                                        :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))))))))
 

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))

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)))))))

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))))