Fix attachment reusal bug

The way that the atom was sometimes dereferenced and sometimes not
caused weird re-rendering artifacts, where sometimes attachment would
show up below posts that they actually did not belong to.
Refactoring all of the different cases to be handled by separate
functions seems to solve this.

public/index.html

@@ -228,13 +228,18 @@
 
      section.posts .post .attachments {
          margin-top: 16px;
-         height: 320px;
+         max-height: 320px;
          display: flex;
          align-items: flex-start;
          max-width: 100%;
          overflow: auto;
      }
 
+     section.posts .post .attachments img,
+     section.posts .post .attachments video {
+         max-height: 320px;
+     }
+
      section.posts .post .controls {
          margin: 24px 0 0;
          padding: 0;

src/computersandblues/lodestone/app.cljs

@@ -160,8 +160,9 @@
 (declare fetch-posts!)
 
 (defn- fetch-application-settings []
-  (->> (db/open-cursor! ::db/application ::db/all)
+  (let [cursor (db/open-cursor ::db/application ::db/all)]
-       (db/first-result (map #(js->clj % :keywordize-keys true)))))
+    (. (db/first-result cursor)
+       (then #(js->clj % :keywordize-keys true)))))
 
 (defn setup-application!
   "Handles Mastodon application setup on the client side"
@@ -198,7 +199,7 @@
       (.then (fn [application]
                (when application
                  (swap! state assoc :section :posts)
-                 (promise-all [application (db/count! ::db/posts)]))))
+                 (promise-all [application (db/count ::db/posts)]))))
       (.then (fn [[application post-count]]
                (when post-count
                  (if (zero? post-count)
@@ -287,29 +288,32 @@
 
 (defn- refresh-displayed-posts!
   [{:keys [per-page query]}]
-  (let [; this `xform` is responsible for filtering and building the final list
+  (let [; this `xform` is responsible for filtering and building the list of
-        ; of results by iterating through the posts in the database.
+        ; results that is displayed to the user. it iterates through all stored
+        ; posts in the database and returns a result that will be rendered
+        ; by the `post` component below.
         xform (comp
                (filter (query->matching-fn query))
                (take per-page)
                (map #(js->clj % :keywordize-keys true)))
-        refresh-id (now)]
+        posts-cursor (db/open-cursor ::db/posts
-    (swap! state update-in [:section/posts :loading] conj refresh-id)
+                                     ::db/all
-    (. (promise-all [(db/count! ::db/posts)
-                     (->> (db/open-cursor! ::db/posts ::db/all
                                      {:index ::db/post-created-at
                                       :direction :desc})
-                          (db/transduce-cursor xform))])
+        refresh-id (now)]
+    (swap! state update-in [:section/posts :loading] conj refresh-id)
+    (. (promise-all [(db/count ::db/posts)
+                     (db/transduce-cursor xform posts-cursor)])
        (then (fn [[total displayed-posts]]
                (swap! state update :section/posts #(-> (assoc % :total total)
                                                        (assoc :displayed-posts displayed-posts)
                                                        (update :loading disj refresh-id))))))))
 
+(def debounced-refresh! (debounce 48 refresh-displayed-posts!))
+
 ; we use reagent's machinery below to define a callback that runs whenever the
 ; values change that serve as input to the current search reults.
 
-(def debounced-refresh! (debounce 48 refresh-displayed-posts!))
-
 (def search-result-inputs (r/reaction (select-keys (:section/posts @state) [:query :per-page :last-update])))
 
 (defonce update-search-results (r/track! (fn []
@@ -349,27 +353,55 @@
         (interleave (repeat ", "))
         (drop 1))])
 
-(defn attachment [{:keys [attachment]}]
+(defn img-attachment [{:keys [attachment preview-url]}]
-  (let [preview-url (or (:preview_remote_url attachment) (:preview_url attachment))
+  [:img {:src preview-url
-        remote-url (or (:remote_url attachment) (:url attachment))
-        ext (last (str/split remote-url #"\."))]
-    (case (:type attachment)
-      "image" [:img {:src preview-url
-                     :srcset (str preview-url ", " remote-url)
          :alt (:description attachment)
-                     :lazy "lazy"}]
+         :loading "lazy"}])
-      "video" [:video {:controls true}
+
+(defn video-attachment [{:keys [attachment remote-url ext]}]
+  [:video {:controls true}
    [:source {:type (str "video/" ext) :src remote-url}]
-               [:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]]
+   [:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]])
-      "gifv" (let [autoplay (r/atom false)
+
+(defn gifv-attachment [{:keys [attachment remote-url ext]}]
+  (let [autoplay (r/atom false)
         toggle-autoplay #(swap! autoplay not)]
     (fn []
       [:video {:loop true :autoplay @autoplay :muted true :on-pointer-enter toggle-autoplay}
        [:source {:type (str "video/" ext) :src remote-url}]
-                 [:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]]))
+       [:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]])))
+
+(defn attachment [{:keys [attachment]}]
+  (let [preview-url (or (:preview_remote_url attachment) (:preview_url attachment))
+        remote-url (or (:remote_url attachment) (:url attachment))
+        ext (last (str/split remote-url #"\."))
+        props {:attachment attachment :preview-url preview-url :remote-url remote-url :ext ext}]
+    (case (:type attachment)
+      "image"  [img-attachment props]
+      "video" [video-attachment props]
+      "gifv" [gifv-attachment props]
       [:div [:strong "Unsupported attachment"]
        [debug attachment]])))
 
+
+(comment
+  ; query current results
+  (-> @state :section/posts :displayed-posts)
+
+  ; run and time a query on the database
+  (do
+    (js/console.log :start (.toISOString (js/Date.)))
+    (let [xform (comp (mapcat (j/get :tags))
+                      #_(filter #(= "typescript" (j/get % :name)))
+                      (take 10))
+          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))))))
+  )
+
 (defn post [{:keys [post]}]
   ; TODO: handle (:sensitive post)
   [:article.post
@@ -432,11 +464,11 @@
   "Returns a promise which resolves to the smallest or largest internal post id.
   This is useful to continue interrupted paginated requests."
   [max-or-min]
-  (->> (db/open-cursor! ::db/posts ::db/all {:index ::db/post-internal-id
+  (let [posts-cursor (db/open-cursor ::db/posts ::db/all {:index ::db/post-internal-id
-                                             :direction (if (= max-or-min :min) :asc :desc)})
+                                                          :direction (if (= max-or-min :min) :asc :desc)})]
-       (db/first-result (keep (j/get :internal_id)))))
+    (db/first-result (keep (j/get :internal_id)) posts-cursor)))
 
-(defn fetch-more-posts! [e]
+(defn- fetch-more-posts! [e]
   (.preventDefault e)
   (. (promise-all [(fetch-application-settings) (internal-post-id :min) (internal-post-id :max)])
      (then (fn [[application min-id max-id]]
@@ -507,7 +539,7 @@
     [:li "If you want to search verbatim for a phrase, \"quote it like this\""]
     [:li "Lodestone tries to turn words into regular expressions. " [:code "fossi.*ergy"] " will match \"fossile energy\"." [:code "bo?ar"] " will match both boar and bar."]]])
 
-;; the component tying it all toger
+;; the component tying it all together
 
 (defn app []
   (let [section (:section @state)
@@ -535,9 +567,9 @@
 
 (defn- convert-internal-ids! []
   ; TODO figure out when we can remove this again
-  (. (->> (db/open-cursor! ::db/posts ::db/all)
+  (let [cursor (db/open-cursor ::db/posts ::db/all)
-          (db/transduce-cursor (filter (comp string? (j/get :internal_id)))))
+        result (db/transduce-cursor (filter (comp string? (j/get :internal_id))) cursor)]
-     (then (fn [rows]
+    (.then result (fn [rows]
                     (doseq [row rows]
                       (db/put! ::db/posts (j/update! row :internal_id parse-long)))))))
 

src/computersandblues/lodestone/database.cljs

@@ -1,4 +1,5 @@
-(ns computersandblues.lodestone.database)
+(ns computersandblues.lodestone.database
+  (:refer-clojure :exclude [count get]))
 
 (defonce +db+ (atom nil))
 
@@ -72,15 +73,15 @@
          request (.put store (clj->js object))]
      (promisify request))))
 
-(defn get!
+(defn get
-  ([store-id k] (get! @+db+ store-id k))
+  ([store-id k] (get @+db+ store-id k))
   ([db store-id k]
    (let [store (open-store db store-id "readonly")
          request (.get store k)]
      (promisify request))))
 
-(defn get-all!
+(defn get-all
-  ([store-id key-range] (get-all! @+db+ store-id key-range))
+  ([store-id key-range] (get-all @+db+ store-id key-range))
   ([db store-id key-range]
    (let [store (open-store db store-id "readonly")
          request (.getAll store key-range)]
@@ -94,23 +95,23 @@
      (promisify request))))
 
 (defn delete!
-  ([store-id k] (get! @+db+ store-id k))
+  ([store-id k] (get @+db+ store-id k))
   ([db store-id k]
    (let [store (open-store db store-id "readwrite")
          request (.delete store k)]
      (promisify request))))
 
-(defn count!
+(defn count
-  ([store-id] (count! @+db+ store-id))
+  ([store-id] (count @+db+ store-id))
   ([db store-id]
    (let [store (open-store db store-id "readonly")
          request (.count store)]
      (promisify request))))
 
 
-(defn open-cursor!
+(defn open-cursor
-  ([store-id key-range] (open-cursor! @+db+ store-id key-range {:direction :asc}))
+  ([store-id key-range] (open-cursor @+db+ store-id key-range {:direction :asc}))
-  ([store-id key-range opts] (open-cursor! @+db+ store-id key-range opts))
+  ([store-id key-range opts] (open-cursor @+db+ store-id key-range opts))
   ([db store-id key-range {:keys [direction index]}]
    (let [store (open-store db store-id "readonly")
          key-range (if (= key-range ::all)
@@ -160,14 +161,21 @@
                                      (.continue cursor))))
                                (resolve @result)))))))))
 
-(defn first-result [xform cursor-req]
+(defn first-result
-  (transduce-cursor (comp xform (take 1)) (fn [_ x] x) cursor-req))
+  "Given a cursor, will return a promise that resolves to the first result.
+
+  Optionally takes an `xform` that can be used to filter or transform values
+  returned by the cursor."
+  ([cursor-req]
+   (first-result (map identity) cursor-req))
+  ([xform cursor-req]
+   (transduce-cursor (comp xform (take 1)) (fn [_ x] x) nil cursor-req)))
 
 (comment
 
   (let [re (js/RegExp. "user" "i")]
     (do (print "starting…" (js/Date.))
-        (-> (open-cursor! ::posts ::all)
+        (-> (open-cursor ::posts ::all)
             (transduce-cursor (comp (filter #(re-find re (.-content %)))
                                     (take 50)
                                     (map #(js->clj % :keywordize-keys true))))