Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-04-06 20:11:29 -05:00
Code Issues Activity

🎉 Add lazy loading and storage/pointer-map support on workspace

Browse source 
This also rewrites the workspace load process making it a bit more
efficient independently if lazy loading is used.
This commit is contained in:
Andrey Antukh 2022-11-18 08:06:01 +01:00 • committed by Andrés Moya
parent 6565655ac3
commit bbf95434d8
16 changed files with 387 additions and 349 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

94
backend/src/app/rpc/commands/files.clj
View file

@ -17,7 +17,6 @@
[app.common.types.shape-tree :as ctt]
[app.db :as db]
[app.db.sql :as sql]
[app.rpc :as-alias rpc]
[app.rpc.commands.files.thumbnails :as-alias thumbs]
[app.rpc.cond :as-alias cond]
[app.rpc.doc :as-alias doc]
@ -56,6 +55,11 @@
(s/def ::search-term ::us/string)
(s/def ::team-id ::us/uuid)
;; --- HELPERS
(def long-cache-duration
(dt/duration {:days 7}))
(defn decode-row
[{:keys [data changes features] :as row}]
(when row
@ -208,6 +212,25 @@
;; QUERY COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- handle-file-features
[{:keys [features] :as file} client-features]
(when (and (contains? features "components/v2")
(not (contains? client-features "components/v2")))
(ex/raise :type :restriction
:code :feature-mismatch
:feature "components/v2"
:hint "file has 'components/v2' feature enabled but frontend didn't specifies it"))
(cond-> file
(and (contains? client-features "components/v2")
(not (contains? features "components/v2")))
(update :data ctf/migrate-to-components-v2)
(and (contains? features "storage/pointer-map")
(not (contains? client-features "storage/pointer-map")))
(process-pointers deref)))
;; --- COMMAND QUERY: get-file (by id)
(defn get-file
@ -216,27 +239,10 @@
(check-features-compatibility! client-features)
(binding [pmap/*load-fn* (partial load-pointer conn id)]
(let [file (->> (db/get-by-id conn :file id)
(decode-row)
(pmg/migrate-file))
features (:features file)
file (cond-> file
(and (contains? client-features "components/v2")
(not (contains? features "components/v2")))
(update :data ctf/migrate-to-components-v2)
(and (contains? features "storage/pointer-map")
(not (contains? client-features "storage/pointer-map")))
(process-pointers deref))]
(when (and (contains? features "components/v2")
(not (contains? client-features "components/v2")))
(ex/raise :type :restriction
:code :feature-mismatch
:feature "components/v2"
:hint "file has 'components/v2' feature enabled but frontend didn't specifies it"))
file)))
(-> (db/get-by-id conn :file id)
(decode-row)
(pmg/migrate-file)
(handle-file-features client-features))))
(defn- get-minimal-file
[{:keys [pool] :as cfg} id]
@ -264,6 +270,26 @@
(vary-meta file assoc ::cond/key (get-file-etag file))))))
;; --- COMMAND QUERY: get-file-fragment (by id)
(defn- get-file-fragment
[conn file-id fragment-id]
(some-> (db/get conn :file-data-fragment {:file-id file-id :id fragment-id})
(update :content blob/decode)))
(s/def ::fragment-id ::us/uuid)
(s/def ::get-file-fragment
(s/keys :req-un [::file-id ::fragment-id ::profile-id]))
(sv/defmethod ::get-file-fragment
"Retrieve a file by its ID. Only authenticated users."
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id fragment-id] :as params}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id)
(-> (get-file-fragment conn file-id fragment-id)
(rph/with-http-cache long-cache-duration))))
;; --- COMMAND QUERY: get-file-object-thumbnails
(defn get-object-thumbnails
@ -484,6 +510,7 @@
)
SELECT l.id,
l.data,
l.features,
l.project_id,
l.created_at,
l.modified_at,
@ -495,22 +522,27 @@
WHERE l.deleted_at IS NULL OR l.deleted_at > now();")
(defn get-file-libraries
[conn is-indirect file-id]
(let [xform (comp
(map #(assoc % :is-indirect is-indirect))
(map decode-row))]
(into #{} xform (db/exec! conn [sql:file-libraries file-id]))))
[conn file-id client-features]
(check-features-compatibility! client-features)
(->> (db/exec! conn [sql:file-libraries file-id])
(mapv (fn [{:keys [id] :as row}]
(binding [pmap/*load-fn* (partial load-pointer conn id)]
(-> (decode-row row)
(assoc :is-indirect false)
(update :data dissoc :pages-index)
(handle-file-features client-features)))))))
(s/def ::get-file-libraries
(s/keys :req-un [::profile-id ::file-id]))
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::features]))
(sv/defmethod ::get-file-libraries
"Get libraries used by the specified file."
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
[{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as params}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id)
(get-file-libraries conn false file-id)))
(get-file-libraries conn file-id features)))
;; --- COMMAND QUERY: Files that use this File library
@ -607,7 +639,7 @@
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id)
(-> (get-file-thumbnail conn file-id revn)
(with-meta {::rpc/transform-response (rph/http-cache {:max-age (* 1000 60 60)})}))))
(rph/with-http-cache long-cache-duration))))
;; --- COMMAND QUERY: get-file-data-for-thumbnail

2
backend/src/app/rpc/commands/viewer.clj
View file

@ -26,7 +26,7 @@
(let [file (files/get-file conn file-id features)
thumbnails (files/get-object-thumbnails conn file-id)
project (get-project conn (:project-id file))
libs (files/get-file-libraries conn false file-id)
libs (files/get-file-libraries conn file-id features)
users (comments/get-file-comments-users conn file-id profile-id)
links (->> (db/query conn :share-link {:file-id file-id})

14
backend/src/app/rpc/helpers.clj
View file

@ -44,13 +44,6 @@
[o]
(if (wrapped? o) @o o))
(defn http-cache
[{:keys [max-age]}]
(fn [_ response]
(let [exp (if (integer? max-age) max-age (inst-ms max-age))
val (dm/fmt "max-age=%" (int (/ exp 1000.0)))]
(update response :headers assoc "cache-control" val))))
(defn with-header
"Add a http header to the RPC result."
[mdw key val]
@ -66,3 +59,10 @@
[mdw hook-fn]
(vary-meta mdw update ::rpc/before-complete-fns conj hook-fn))
(defn with-http-cache
[mdw max-age]
(vary-meta mdw update ::rpc/response-transform-fns conj
(fn [_ response]
(let [exp (if (integer? max-age) max-age (inst-ms max-age))
val (dm/fmt "max-age=%" (int (/ exp 1000.0)))]
(update response :headers assoc "cache-control" val)))))

9
backend/src/app/rpc/queries/files.clj
View file

@ -8,10 +8,9 @@
(:require
[app.common.spec :as us]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as cmd.files]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rpch]
[app.rpc.helpers :as rph]
[app.rpc.queries.projects :as projects]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
@ -127,10 +126,10 @@
(sv/defmethod ::file-libraries
{::doc/added "1.3"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
[{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as params}]
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(cmd.files/get-file-libraries conn false file-id)))
(cmd.files/get-file-libraries conn file-id features)))
;; --- Query: Files that use this File library
@ -169,4 +168,4 @@
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(-> (cmd.files/get-file-thumbnail conn file-id revn)
(with-meta {::rpc/transform-response (rpch/http-cache {:max-age (* 1000 60 60)})}))))
(rph/with-http-cache cmd.files/long-cache-duration))))

21
common/src/app/common/transit.cljc
View file

@ -35,7 +35,24 @@
;; A generic pointer; mainly used for deserialize backend pointer-map
;; instances that serializes to pointer but may in other ways.
(defrecord Pointer [id])
(deftype Pointer [id metadata]
#?@(:clj
[clojure.lang.IObj
(meta [_] metadata)
(withMeta [_ meta] (Pointer. id meta))
clojure.lang.IDeref
(deref [_] id)]
:cljs
[cljs.core/IMeta
(-meta [_] metadata)
cljs.core/IWithMeta
(-with-meta [_ meta] (Pointer. id meta))
cljs.core/IDeref
(-deref [_] id)]))
(defn pointer?
[o]
(instance? Pointer o))
;; --- HELPERS
@ -140,7 +157,7 @@
{:id "penpot/pointer"
:class Pointer
:rfn (fn [[id meta]]
(Pointer. id meta {}))}
(Pointer. id meta))}
#?(:clj
{:id "m"

6
common/src/app/common/types/shape_tree.cljc
View file

@ -278,12 +278,6 @@
[objects]
(with-meta objects {::index-frames (get-frames (with-meta objects nil))}))
(defn start-object-indices
[file]
(letfn [(process-index [page-index page-id]
(update-in page-index [page-id :objects] start-page-index))]
(update file :pages-index #(reduce process-index % (keys %)))))
(defn update-object-indices
[file page-id]
(update-in file [:pages-index page-id :objects] update-page-index))

352
frontend/src/app/main/data/workspace.cljs
View file

@ -9,6 +9,7 @@
[app.common.attrs :as attrs]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.features :as ffeat]
[app.common.geom.align :as gal]
[app.common.geom.point :as gpt]
[app.common.geom.proportions :as gpr]
@ -27,16 +28,16 @@
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.config :as cf]
[app.main.data.comments :as dcm]
[app.main.data.events :as ev]
[app.main.data.fonts :as df]
[app.main.data.messages :as msg]
[app.main.data.modal :as modal]
[app.main.data.users :as du]
[app.main.data.workspace.bool :as dwb]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.collapse :as dwco]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.fix-bool-contents :as fbc]
@ -64,6 +65,7 @@
[app.main.features :as features]
[app.main.repo :as rp]
[app.main.streams :as ms]
[app.main.worker :as uw]
[app.util.dom :as dom]
[app.util.globals :as ug]
[app.util.http :as http]
@ -77,26 +79,27 @@
[linked.core :as lks]
[potok.core :as ptk]))
(s/def ::shape-attrs ::cts/shape-attrs)
(s/def ::set-of-string
(s/every string? :kind set?))
(def default-workspace-local {:zoom 1})
(s/def ::layout-name (s/nilable ::us/keyword))
(s/def ::coll-of-uuids (s/coll-of ::us/uuid))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare file-initialized)
(declare remove-graphics)
(declare ^:private workspace-initialized)
(declare ^:private remove-graphics)
(declare ^:private libraries-fetched)
;; --- Initialize Workspace
(def default-workspace-local
{:zoom 1})
(defn initialize
(defn initialize-layout
[lname]
(us/verify (s/nilable ::us/keyword) lname)
(ptk/reify ::initialize
(us/assert! ::layout-name lname)
(ptk/reify ::initialize-layout
ptk/UpdateEvent
(update [_ state]
(-> state
@ -109,10 +112,168 @@
(rx/of (layout/ensure-layout lname))
(rx/of (layout/ensure-layout :layers))))))
(defn- workspace-initialized
[]
(ptk/reify ::workspace-initialized
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc :workspace-undo {})
(assoc :workspace-ready? true)))
ptk/WatchEvent
(watch [_ state _]
(let [file (:workspace-file state)
has-graphics? (-> file :data :media seq)
components-v2 (features/active-feature? state :components-v2)]
(rx/merge
(rx/of (fbc/fix-bool-contents))
(if (and has-graphics? components-v2)
(rx/of (remove-graphics (:id file) (:name file)))
(rx/empty)))))))
(defn- workspace-data-loaded
[data]
(ptk/reify ::workspace-data-loaded
ptk/UpdateEvent
(update [_ state]
(let [data (d/removem (comp t/pointer? val) data)]
(assoc state :workspace-data data)))))
(defn- workspace-data-pointers-loaded
[pdata]
(ptk/reify ::workspace-data-pointers-loaded
ptk/UpdateEvent
(update [_ state]
(update state :workspace-data merge pdata))))
(defn- bundle-fetched
[features [{:keys [id data] :as file} thumbnails project users comments-users]]
(letfn [(resolve-pointer [[key pointer]]
(->> (rp/cmd! :get-file-fragment {:file-id id :fragment-id @pointer})
(rx/map :content)
(rx/map #(vector key %))))
(resolve-pointers [in-to coll]
(->> (rx/from (seq coll))
(rx/merge-map resolve-pointer)
(rx/reduce conj in-to)))]
(ptk/reify ::bundle-fetched
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc :workspace-thumbnails thumbnails)
(assoc :workspace-file (dissoc file :data))
(assoc :workspace-project project)
(assoc :current-team-id (:team-id project))
(assoc :users (d/index-by :id users))
(assoc :current-file-comments-users (d/index-by :id comments-users))))
ptk/WatchEvent
(watch [_ _ stream]
(let [team-id (:team-id project)
stoper (rx/filter (ptk/type? ::bundle-fetched) stream)]
(->> (rx/merge
;; Initialize notifications & load team fonts
(rx/of (dwn/initialize team-id id)
(df/load-team-fonts team-id))
;; Load all pages, independently if they are pointers or already
;; resolved values.
(->> (rx/from (seq (:pages-index data)))
(rx/merge-map
(fn [[_ page :as kp]]
(if (t/pointer? page)
(resolve-pointer kp)
(rx/of kp))))
(rx/merge-map
(fn [[id page]]
(let [page (update page :objects ctst/start-page-index)]
(->> (uw/ask! {:cmd :initialize-page-index :page page})
(rx/map (constantly [id page]))))))
(rx/reduce conj {})
(rx/map (fn [pages-index]
(-> data
(assoc :pages-index pages-index)
(workspace-data-loaded)))))
;; Once workspace data is loaded, proceed asynchronously load
;; the local library and all referenced libraries, without
;; blocking the main workspace load process.
(->> stream
(rx/filter (ptk/type? ::workspace-data-loaded))
(rx/take 1)
(rx/merge-map
(fn [_]
(rx/merge
(rx/of (workspace-initialized))
(->> data
(filter (comp t/pointer? val))
(resolve-pointers {})
(rx/map workspace-data-pointers-loaded))
(->> (rp/cmd! :get-file-libraries {:file-id id :features features})
(rx/mapcat identity)
(rx/merge-map
(fn [file]
(->> (filter (comp t/pointer? val) file)
(resolve-pointers file))))
(rx/reduce conj [])
(rx/map libraries-fetched)))))))
(rx/take-until stoper)))))))
(defn- libraries-fetched
[libraries]
(ptk/reify ::libraries-fetched
ptk/UpdateEvent
(update [_ state]
(assoc state :workspace-libraries (d/index-by :id libraries)))
ptk/WatchEvent
(watch [_ state _]
(let [ignore-until (-> state :workspace-file :ignore-sync-until)
file-id (-> state :workspace-file :id)
needs-update? (some #(and (> (:modified-at %) (:synced-at %))
(or (not ignore-until)
(> (:modified-at %) ignore-until)))
libraries)]
(when needs-update?
(rx/of (dwl/notify-sync-file file-id)))))))
(defn- fetch-bundle
[project-id file-id]
(ptk/reify ::fetch-bundle
ptk/WatchEvent
(watch [_ state stream]
(let [features (cond-> ffeat/enabled
(features/active-feature? state :components-v2)
(conj "components/v2")
;; We still put the feature here and not in the
;; ffeat/enabled var because the pointers map is only
;; supported on workspace bundle fetching mechanism.
:always
(conj "storage/pointer-map"))
;; WTF is this?
share-id (-> state :viewer-local :share-id)
stoper (rx/filter (ptk/type? ::fetch-bundle) stream)]
(->> (rx/zip (rp/cmd! :get-file {:id file-id :features features})
(rp/cmd! :get-file-object-thumbnails {:file-id file-id})
(rp/query! :project {:id project-id})
(rp/query! :team-users {:file-id file-id})
(rp/cmd! :get-profiles-for-file-comments {:file-id file-id :share-id share-id}))
(rx/take 1)
(rx/map (partial bundle-fetched features))
(rx/take-until stoper))))))
(defn initialize-file
[project-id file-id]
(us/verify ::us/uuid project-id)
(us/verify ::us/uuid file-id)
(us/assert! ::us/uuid project-id)
(us/assert! ::us/uuid file-id)
(ptk/reify ::initialize-file
ptk/UpdateEvent
@ -123,80 +284,16 @@
:workspace-presence {}))
ptk/WatchEvent
(watch [_ _ stream]
(rx/merge
(rx/of (dwp/fetch-bundle project-id file-id)
(dcm/retrieve-comment-threads file-id))
;; Initialize notifications (websocket connection) and the file persistence
(->> stream
(rx/filter (ptk/type? ::dwp/bundle-fetched))
(rx/take 1)
(rx/map deref)
(rx/mapcat
(fn [bundle]
(rx/merge
(rx/of (dwc/initialize-indices bundle))
(->> (rx/of bundle)
(rx/mapcat
(fn [bundle]
(let [file (-> bundle :file-raw t/decode-str)
bundle (assoc bundle :file file)
team-id (dm/get-in bundle [:project :team-id])]
(rx/merge
(rx/of (dwn/initialize team-id file-id)
(dwp/initialize-file-persistence file-id))
(->> stream
(rx/filter #(= ::dwc/index-initialized %))
(rx/take 1)
(rx/map #(file-initialized bundle))))))))))))))
(watch [_ _ _]
(rx/of (dcm/retrieve-comment-threads file-id)
(dwp/initialize-file-persistence file-id)
(fetch-bundle project-id file-id)))
ptk/EffectEvent
(effect [_ _ _]
(let [name (str "workspace-" file-id)]
(unchecked-set ug/global "name" name)))))
(defn- file-initialized
[{:keys [file thumbnails users project libraries file-comments-users] :as bundle}]
(ptk/reify ::file-initialized
ptk/UpdateEvent
(update [_ state]
(assoc state
:current-team-id (:team-id project)
:users (d/index-by :id users)
:workspace-undo {}
:workspace-project project
:workspace-file (assoc file :initialized true)
:workspace-thumbnails thumbnails
:workspace-data (-> (:data file)
(ctst/start-object-indices)
;; DEBUG: Uncomment this to try out migrations in local without changing
;; the version number
#_(assoc :version 17)
#_(app.common.pages.migrations/migrate-data 19))
:workspace-libraries (d/index-by :id libraries)
:current-file-comments-users (d/index-by :id file-comments-users)))
ptk/WatchEvent
(watch [_ state _]
(let [file-id (:id file)
ignore-until (:ignore-sync-until file)
some-graphics? (some? (-> file :data :media))
needs-update? (some #(and (> (:modified-at %) (:synced-at %))
(or (not ignore-until)
(> (:modified-at %) ignore-until)))
libraries)
components-v2 (features/active-feature? state :components-v2)]
(rx/merge
(rx/of (fbc/fix-bool-contents))
(if (and some-graphics? components-v2)
(rx/of (remove-graphics (:id file) (:name file)))
(rx/empty))
(if needs-update?
(rx/of (dwl/notify-sync-file file-id))
(rx/empty)))))))
(defn finalize-file
[_project-id file-id]
(ptk/reify ::finalize-file
@ -209,6 +306,7 @@
:workspace-editor-state
:workspace-file
:workspace-libraries
:workspace-ready?
:workspace-media-objects
:workspace-persistence
:workspace-presence
@ -224,55 +322,73 @@
(rx/observe-on :async))))))
(declare go-to-page)
(declare ^:private preload-data-uris)
(defn initialize-page
[page-id]
(us/assert ::us/uuid page-id)
(us/assert! ::us/uuid page-id)
(ptk/reify ::initialize-page
ptk/WatchEvent
(watch [_ state _]
(if (contains? (get-in state [:workspace-data :pages-index]) page-id)
(rx/of (dwp/preload-data-uris)
(dwth/watch-state-changes)
(dwl/watch-component-changes))
(let [default-page-id (get-in state [:workspace-data :pages 0])]
(rx/of (go-to-page default-page-id)))))
ptk/UpdateEvent
(update [_ state]
(if-let [{:keys [id] :as page} (get-in state [:workspace-data :pages-index page-id])]
;; we maintain a cache of page state for user convenience with
;; the exception of the selection; when user abandon the
;; current page, the selection is lost
(let [local (-> state
(get-in [:workspace-cache id] default-workspace-local)
(assoc :selected (d/ordered-set)))]
(if-let [{:keys [id] :as page} (dm/get-in state [:workspace-data :pages-index page-id])]
;; we maintain a cache of page state for user convenience with the exception of the
;; selection; when user abandon the current page, the selection is lost
(let [local (dm/get-in state [:workspace-cache id] default-workspace-local)]
(-> state
(assoc :current-page-id id)
(assoc :trimmed-page (dm/select-keys page [:id :name]))
(assoc :workspace-local local)
(assoc :workspace-local (assoc local :selected (d/ordered-set)))
(assoc :workspace-trimmed-page (dm/select-keys page [:id :name]))
;; FIXME: this should be done on `initialize-layout` (?)
(update :workspace-layout layout/load-layout-flags)
(update :workspace-global layout/load-layout-state)
(update :workspace-global assoc :background-color (-> page :options :background))
(update-in [:route :params :query] assoc :page-id (dm/str id))))
state))))
state))
ptk/WatchEvent
(watch [_ state _]
(let [pindex (-> state :workspace-data :pages-index)]
(if (contains? pindex page-id)
(rx/of (preload-data-uris page-id)
(dwth/watch-state-changes)
(dwl/watch-component-changes))
(let [page-id (dm/get-in state [:workspace-data :pages 0])]
(rx/of (go-to-page page-id))))))))
(defn finalize-page
[page-id]
(us/assert ::us/uuid page-id)
(us/assert! ::us/uuid page-id)
(ptk/reify ::finalize-page
ptk/UpdateEvent
(update [_ state]
(let [local (-> (:workspace-local state)
(dissoc :edition
:edit-path
:selected))
exit-workspace? (not= :workspace (get-in state [:route :data :name]))]
(cond-> (assoc-in state [:workspace-cache page-id] local)
:always
(dissoc :current-page-id :workspace-local :trimmed-page :workspace-focus-selected)
exit-workspace?
(dissoc :workspace-drawing))))))
(dissoc :edition :edit-path :selected))
exit? (not= :workspace (dm/get-in state [:route :data :name]))
state (-> state
(update :workspace-cache assoc page-id local)
(dissoc :current-page-id :workspace-local :workspace-trimmed-page :workspace-focus-selected))]
(cond-> state
exit? (dissoc :workspace-drawing))))))
(defn- preload-data-uris
"Preloads the image data so it's ready when necessary"
[page-id]
(ptk/reify ::preload-data-uris
ptk/EffectEvent
(effect [_ state _]
(let [xform (comp (map second)
(keep (fn [{:keys [metadata fill-image]}]
(cond
(some? metadata) (cf/resolve-file-media metadata)
(some? fill-image) (cf/resolve-file-media fill-image)))))
uris (into #{} xform (wsh/lookup-page-objects state page-id))]
(->> (rx/from uris)
(rx/subs #(http/fetch-data-uri % false)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace Page CRUD
@ -426,7 +542,7 @@
(defn update-shape
[id attrs]
(us/verify ::us/uuid id)
(us/verify ::shape-attrs attrs)
(us/verify ::cts/shape-attrs attrs)
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
@ -452,7 +568,7 @@
(defn update-selected-shapes
[attrs]
(us/verify ::shape-attrs attrs)
(us/verify ::cts/shape-attrs attrs)
(ptk/reify ::update-selected-shapes
ptk/WatchEvent
(watch [_ state _]
@ -868,7 +984,7 @@
qparams {:page-id page-id}]
(rx/of (rt/nav' :workspace pparams qparams))))))
([page-id]
(us/verify ::us/uuid page-id)
(us/assert! ::us/uuid page-id)
(ptk/reify ::go-to-page-2
ptk/WatchEvent
(watch [_ state _]
@ -1135,7 +1251,7 @@
(prepare-object [objects selected+children {:keys [type] :as obj}]
(let [obj (maybe-translate obj objects selected+children)]
(if (= type :image)
(let [url (cfg/resolve-file-media (:metadata obj))]
(let [url (cf/resolve-file-media (:metadata obj))]
(->> (http/send! {:method :get
:uri url
:response-type :blob})
@ -1466,7 +1582,7 @@
(defn paste-text
[text]
(us/assert string? text)
(us/assert! (string? text) "expected string as first argument")
(ptk/reify ::paste-text
ptk/WatchEvent
(watch [_ state _]
@ -1496,7 +1612,7 @@
;; TODO: why not implement it in terms of upload-media-workspace?
(defn- paste-svg
[text]
(us/assert string? text)
(us/assert! (string? text) "expected string as first argument")
(ptk/reify ::paste-svg
ptk/WatchEvent
(watch [_ state _]

2
frontend/src/app/main/data/workspace/changes.cljs
View file

@ -78,7 +78,7 @@
ptk/EffectEvent
(effect [_ state _]
(doseq [[page-id changes] (::update-changes state)]
(uw/ask! {:cmd :update-page-indices
(uw/ask! {:cmd :update-page-index
:page-id page-id
:changes changes})))))

13
frontend/src/app/main/data/workspace/common.cljs
View file

@ -9,7 +9,6 @@
[app.common.logging :as log]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.undo :as dwu]
[app.main.worker :as uw]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -27,18 +26,6 @@
(defn interrupt? [e] (= e :interrupt))
;; --- Selection Index Handling
(defn initialize-indices
[{:keys [file-raw] :as bundle}]
(ptk/reify ::setup-selection-index
ptk/WatchEvent
(watch [_ _ _]
(let [msg {:cmd :initialize-indices
:file-raw file-raw}]
(->> (uw/ask! msg)
(rx/map (constantly ::index-initialized)))))))
;; These functions should've been in `src/app/main/data/workspace/undo.cljs` but doing that causes
;; a circular dependency with `src/app/main/data/workspace/changes.cljs`
(def undo

116
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -8,24 +8,17 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.features :as ffeat]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[app.common.types.file :as ctf]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.dashboard :as dd]
[app.main.data.fonts :as df]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.thumbnails :as dwt]
[app.main.features :as features]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.http :as http]
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
@ -156,9 +149,10 @@
(->> (rp/cmd! :update-file params)
(rx/mapcat (fn [lagged]
(log/debug :hint "changes persisted" :lagged (count lagged))
(let [lagged (cond->> lagged
(= #{sid} (into #{} (map :session-id) lagged))
(map #(assoc % :changes [])))
(let [lagged-updates
(cond->> lagged
(= #{sid} (into #{} (map :session-id) lagged))
(map #(assoc % :changes [])))
frame-updates
(-> (group-by :page-id changes)
@ -166,10 +160,10 @@
(rx/merge
(->> (rx/from frame-updates)
(rx/flat-map (fn [[page-id frames]]
(->> frames (map #(vector page-id %)))))
(rx/mapcat (fn [[page-id frames]]
(->> frames (map #(vector page-id %)))))
(rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail (:id file) page-id frame-id))))
(->> (rx/of lagged)
(->> (rx/of lagged-updates)
(rx/mapcat seq)
(rx/map #(shapes-changes-persisted file-id %)))))))
(rx/catch (fn [cause]
@ -179,7 +173,6 @@
(rx/of (rt/assign-exception cause)))
(rx/throw cause))))))))))
(defn persist-synchronous-changes
[{:keys [file-id changes]}]
(us/verify ::us/uuid file-id)
@ -202,7 +195,6 @@
(->> (rp/mutation :update-file params)
(rx/ignore)))))))
(defn update-persistence-status
[{:keys [status reason]}]
(ptk/reify ::update-persistence-status
@ -215,6 +207,7 @@
:status status
:updated-at (dt/now)))))))
(s/def ::revn ::us/integer)
(s/def ::shapes-changes-persisted
(s/keys :req-un [::revn ::pcs/changes]))
@ -223,8 +216,8 @@
(defn shapes-changes-persisted
[file-id {:keys [revn changes] :as params}]
(us/verify ::us/uuid file-id)
(us/verify ::shapes-changes-persisted params)
(us/verify! ::us/uuid file-id)
(us/verify! ::shapes-changes-persisted params)
(ptk/reify ::changes-persisted
ptk/UpdateEvent
(update [_ state]
@ -249,94 +242,5 @@
(update-in [:workspace-libraries file-id :data]
cp/process-changes changes)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Fetching & Uploading
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Specs
(s/def ::id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::name string?)
(s/def ::type keyword?)
(s/def ::file-id ::us/uuid)
(s/def ::created-at ::us/inst)
(s/def ::modified-at ::us/inst)
(s/def ::version ::us/integer)
(s/def ::revn ::us/integer)
(s/def ::ordering ::us/integer)
(s/def ::data ::ctf/data)
(s/def ::file ::dd/file)
(s/def ::project ::dd/project)
(s/def ::page
(s/keys :req-un [::id
::name
::file-id
::revn
::created-at
::modified-at
::ordering
::data]))
(declare fetch-libraries-content)
(declare bundle-fetched)
(defn fetch-bundle
[project-id file-id]
(ptk/reify ::fetch-bundle
ptk/WatchEvent
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)
features (cond-> ffeat/enabled
(features/active-feature? state :components-v2)
(conj "components/v2"))]
(->> (rx/zip (rp/cmd! :get-raw-file {:id file-id :features features})
(rp/cmd! :get-file-object-thumbnails {:file-id file-id})
(rp/query! :team-users {:file-id file-id})
(rp/query! :project {:id project-id})
(rp/cmd! :get-file-libraries {:file-id file-id})
(rp/cmd! :get-profiles-for-file-comments {:file-id file-id :share-id share-id}))
(rx/take 1)
(rx/map (fn [[file-raw thumbnails users project libraries file-comments-users]]
{:file-raw file-raw
:thumbnails thumbnails
:users users
:project project
:libraries libraries
:file-comments-users file-comments-users}))
(rx/mapcat (fn [{:keys [project] :as bundle}]
(rx/of (ptk/data-event ::bundle-fetched bundle)
(df/load-team-fonts (:team-id project))))))))))
;; --- Helpers
(defn purge-page
"Remove page and all related stuff from the state."
[state id]
(-> state
(update-in [:workspace-file :pages] #(filterv (partial not= id) %))
(update :workspace-pages dissoc id)))
(defn preload-data-uris
"Preloads the image data so it's ready when necessary"
[]
(ptk/reify ::preload-data-uris
ptk/WatchEvent
(watch [_ state _]
(let [extract-urls
(fn [{:keys [metadata fill-image]}]
(cond
(some? metadata)
[(cf/resolve-file-media metadata)]
(some? fill-image)
[(cf/resolve-file-media fill-image)]))
uris (into #{}
(comp (mapcat extract-urls)
(filter some?))
(vals (wsh/lookup-page-objects state)))]
(->> (rx/from uris)
(rx/merge-map #(http/fetch-data-uri % false))
(rx/ignore))))))

3
frontend/src/app/main/refs.cljs
View file

@ -101,6 +101,9 @@
(def workspace-drawing
(l/derived :workspace-drawing st/state))
(def workspace-ready?
(l/derived :workspace-ready? st/state))
;; TODO: rename to workspace-selected (?)
;; Don't use directly from components, this is a proxy to improve performance of selected-shapes
(def ^:private selected-shapes-data

1
frontend/src/app/main/repo.cljs
View file

@ -15,6 +15,7 @@
(derive :get-file ::query)
(derive :get-file-object-thumbnails ::query)
(derive :get-file-libraries ::query)
(derive :get-file-fragment ::query)
(defn handle-response
[{:keys [status body] :as response}]

8
frontend/src/app/main/ui/workspace.cljs
View file

@ -90,7 +90,7 @@
:selected selected
:layout layout}]])]))
(def trimmed-page-ref (l/derived :trimmed-page st/state =))
(def trimmed-page-ref (l/derived :workspace-trimmed-page st/state =))
(mf/defc workspace-page
[{:keys [file layout page-id wglobal] :as props}]
@ -121,6 +121,7 @@
project (mf/deref refs/workspace-project)
layout (mf/deref refs/workspace-layout)
wglobal (mf/deref refs/workspace-global)
ready? (mf/deref refs/workspace-ready?)
components-v2 (features/use-feature :components-v2)
@ -128,7 +129,7 @@
;; Setting the layout preset by its name
(mf/with-effect [layout-name]
(st/emit! (dw/initialize layout-name)))
(st/emit! (dw/initialize-layout layout-name)))
(mf/with-effect [project-id file-id]
(st/emit! (dw/initialize-file project-id file-id))
@ -160,8 +161,7 @@
[:& context-menu]
(if (and (and file project)
(:initialized file))
(if ready?
[:& workspace-page {:key (dm/str "page-" page-id)
:page-id page-id
:file file

36
frontend/src/app/worker/impl.cljs
View file

@ -9,7 +9,6 @@
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.common.pages.changes :as ch]
[app.common.transit :as t]
[app.config :as cf]
[okulary.core :as l]))
@ -31,29 +30,24 @@
[message]
message)
(defmethod handler :initialize-indices
[{:keys [file-raw] :as message}]
(defmethod handler :initialize-page-index
[{:keys [page] :as message}]
(swap! state update :pages-index assoc (:id page) page)
(handler (assoc message :cmd :selection/initialize-page-index))
(handler (assoc message :cmd :snaps/initialize-page-index)))
(let [data (-> (t/decode-str file-raw) :data)
message (assoc message :data data)]
(reset! state data)
(handler (assoc message :cmd :selection/initialize-index))
(handler (assoc message :cmd :snaps/initialize-index))))
(defmethod handler :update-page-indices
(defmethod handler :update-page-index
[{:keys [page-id changes] :as message}]
(let [old-page (dm/get-in @state [:pages-index page-id])]
(swap! state ch/process-changes changes false)
(let [new-page (dm/get-in @state [:pages-index page-id])
message (assoc message
:old-page old-page
:new-page new-page)]
(handler (-> message
(assoc :cmd :selection/update-index)))
(handler (-> message
(assoc :cmd :snaps/update-index))))))
(let [old-page (dm/get-in @state [:pages-index page-id])
new-page (-> state
(swap! ch/process-changes changes false)
(dm/get-in [:pages-index page-id]))
message (assoc message
:old-page old-page
:new-page new-page)]
(handler (assoc message :cmd :selection/update-page-index))
(handler (assoc message :cmd :snaps/update-page-index))))
(defmethod handler :configure
[{:keys [key val]}]

48
frontend/src/app/worker/selection.cljs
View file

@ -153,40 +153,34 @@
result)))
(defmethod impl/handler :selection/initialize-index
[{:keys [data] :as message}]
(letfn [(index-page [state page]
(let [id (:id page)
objects (:objects page)]
(assoc state id (create-index objects))))
(update-state [state]
(reduce index-page state (vals (:pages-index data))))]
(swap! state update-state)
(defmethod impl/handler :selection/initialize-page-index
[{:keys [page] :as message}]
(letfn [(add-page [state {:keys [id objects] :as page}]
(assoc state id (create-index objects)))]
(swap! state add-page page)
nil))
(defmethod impl/handler :selection/update-index
(defmethod impl/handler :selection/update-page-index
[{:keys [page-id old-page new-page] :as message}]
(let [old-objects (:objects old-page)
new-objects (:objects new-page)
update-page-index
(fn [index]
(let [old-bounds (:bounds index)
new-bounds (objects-bounds new-objects)]
(swap! state update page-id
(fn [index]
(let [old-objects (:objects old-page)
new-objects (:objects new-page)
old-bounds (:bounds index)
new-bounds (objects-bounds new-objects)]
;; If the new bounds are contained within the old bounds we can
;; update the index.
;; Otherwise we need to re-create it
(if (and (some? index)
(gsh/contains-selrect? old-bounds new-bounds))
(update-index index old-objects new-objects)
(create-index new-objects))))]
(swap! state update page-id update-page-index))
;; If the new bounds are contained within the old bounds
;; we can update the index. Otherwise we need to
;; re-create it.
(if (and (some? index)
(gsh/contains-selrect? old-bounds new-bounds))
(update-index index old-objects new-objects)
(create-index new-objects)))))
nil)
(defmethod impl/handler :selection/query
[{:keys [page-id rect frame-id full-frame? include-frames? ignore-groups? clip-children?]
:or {full-frame? false include-frames? false clip-children? true} :as message}]
:or {full-frame? false include-frames? false clip-children? true}
:as message}]
(when-let [index (get @state page-id)]
(query-index index rect frame-id full-frame? include-frames? ignore-groups? clip-children?)))

11
frontend/src/app/worker/snaps.cljs
View file

@ -13,15 +13,12 @@
(defonce state (l/atom {}))
;; Public API
(defmethod impl/handler :snaps/initialize-index
[{:keys [data] :as message}]
(let [pages (vals (:pages-index data))]
(reset! state (reduce sd/add-page (sd/make-snap-data) pages)))
(defmethod impl/handler :snaps/initialize-page-index
[{:keys [page] :as message}]
(swap! state sd/add-page page)
nil)
(defmethod impl/handler :snaps/update-index
(defmethod impl/handler :snaps/update-page-index
[{:keys [old-page new-page] :as message}]
(swap! state sd/update-page old-page new-page)
nil)