Compare commits

...

6 commits

Author SHA1 Message Date
58d709f7be 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.
2025-11-21 13:59:09 +01:00
bddb3b97fa Handle attachments with height < 320px 2025-11-21 13:47:19 +01:00
a02c33c620 Clean up database calls 2025-11-21 13:39:26 +01:00
54067c2103 Shout less in database wrapper 2025-11-21 13:15:00 +01:00
5eb75a3ac2 Fix typo 2025-11-21 13:07:28 +01:00
28eb3655c3 Fix lazy image loading 2025-11-21 09:12:55 +01:00
3 changed files with 96 additions and 51 deletions

View file

@ -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;

View file

@ -160,8 +160,9 @@
(declare fetch-posts!)
(defn- fetch-application-settings []
(->> (db/open-cursor! ::db/application ::db/all)
(db/first-result (map #(js->clj % :keywordize-keys true)))))
(let [cursor (db/open-cursor ::db/application ::db/all)]
(. (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
; of results by iterating through the posts in the database.
(let [; this `xform` is responsible for filtering and building the list of
; 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)]
(swap! state update-in [:section/posts :loading] conj refresh-id)
(. (promise-all [(db/count! ::db/posts)
(->> (db/open-cursor! ::db/posts ::db/all
posts-cursor (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]}]
(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 #"\."))]
(case (:type attachment)
"image" [:img {:src preview-url
:srcset (str preview-url ", " remote-url)
(defn img-attachment [{:keys [attachment preview-url]}]
[:img {:src preview-url
:alt (:description attachment)
:lazy "lazy"}]
"video" [:video {:controls true}
:loading "lazy"}])
(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))]]
"gifv" (let [autoplay (r/atom false)
[:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]])
(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
:direction (if (= max-or-min :min) :asc :desc)})
(db/first-result (keep (j/get :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)})]
(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)
(db/transduce-cursor (filter (comp string? (j/get :internal_id)))))
(then (fn [rows]
(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)))))))

View file

@ -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!
([store-id k] (get! @+db+ store-id k))
(defn get
([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!
([store-id key-range] (get-all! @+db+ store-id key-range))
(defn get-all
([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!
([store-id] (count! @+db+ store-id))
(defn count
([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!
([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))
(defn open-cursor
([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))
([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]
(transduce-cursor (comp xform (take 1)) (fn [_ x] x) cursor-req))
(defn first-result
"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))))