mirror of
https://github.com/penpot/penpot.git
synced 2026-10-29 05:50:35 +00:00
⚡ Relink file and media references only where shapes keep them
Every branch read and compare re-points the references a document holds to a file or a media object. The generic walk visited every map of the document: 704 ms on a file of 90,720 shapes. The relinker now visits only the places listed in `cfh/shape-ref-paths` (plus the paths older data versions used, which binfile import still meets), compiled once into closures that rebuild only what changed: 100 ms on the same file, with an equal result. `remap-changes` dispatches on the change type instead of walking whole change maps. A new test derives every uuid path from the shape schema and fails when a path is neither listed as a reference nor classified as none, so a reference field added later cannot be missed silently. The grid colour schema now declares the library reference it already carried. AI-assisted-by: claude-opus-5-5
This commit is contained in:
Álvaro Tejero Cantero
parent
8444ee5595
commit
03eb22b945
@ -900,7 +900,7 @@
|
||||
|
||||
update-shapes
|
||||
(fn [data {:keys [page-id shape-id]}]
|
||||
(d/update-in-when data [:pages-index page-id :objects shape-id] cfh/relink-refs lookup-index))
|
||||
(d/update-in-when data [:pages-index page-id :objects shape-id] cfh/relink-shape lookup-index))
|
||||
|
||||
file
|
||||
(update file :data #(reduce update-shapes % media-refs))]
|
||||
@ -968,13 +968,6 @@
|
||||
[object-id file-id]
|
||||
(str/replace-first object-id #"^(.*?)/" (str file-id "/")))
|
||||
|
||||
(defn- relink-shapes
|
||||
"A function responsible to analyze all file data and
|
||||
replace the old :component-file reference with the new
|
||||
ones, using the provided file-index."
|
||||
[data]
|
||||
(cfh/relink-refs data lookup-index))
|
||||
|
||||
(defn- relink-media
|
||||
"A function responsible of process the :media attr of file data and
|
||||
remap the old ids with the new ones."
|
||||
@ -1061,10 +1054,12 @@
|
||||
(-> fdata
|
||||
(assoc :id id)
|
||||
(dissoc :recent-colors))))
|
||||
;; relink before migrating: migrations resolve `:component-file`
|
||||
;; against this file's libraries, so the data may still hold
|
||||
;; legacy refs (`cfh/legacy-shape-ref-paths`)
|
||||
(update :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index relink-shapes)
|
||||
(update :components relink-shapes)
|
||||
(cfh/relink-containers lookup-index)
|
||||
(update :media relink-media)
|
||||
(update :colors relink-colors)
|
||||
(d/without-nils))))
|
||||
|
||||
@ -1242,7 +1242,7 @@
|
||||
(import-storage-objects cfg)
|
||||
|
||||
;; Pre-resolve external libraries and add their id mappings to the index
|
||||
;; BEFORE importing files. This allows relink-refs (inside process-file)
|
||||
;; BEFORE importing files. This allows relink-containers (inside process-file)
|
||||
;; to correctly remap :component-file references to the destination library.
|
||||
;; Only remap when a link will actually be created (single match + can-edit).
|
||||
(let [decisions (compute-link-decisions cfg)]
|
||||
|
||||
@ -1086,11 +1086,10 @@
|
||||
|
||||
(defn remap-refs
|
||||
"Rewrite cross-file references in `data` through `id-map`
|
||||
({old-id -> new-id}): the file refs `cfh/relink-refs` rewrites
|
||||
(`:component-file`, `:fill-color-ref-file`, `:stroke-color-ref-file`,
|
||||
`:typography-ref-file`, shadow/grid `:file-id`) plus the media refs
|
||||
(shape `:metadata`/`:fill-image`/`:stroke-image` ids, the `:media`
|
||||
collection keys and library-color `:image` ids). It is the same surface
|
||||
({old-id -> new-id}): the file and media refs every shape holds
|
||||
(`cfh/shape-ref-paths` and `cfh/legacy-shape-ref-paths`) and the page
|
||||
default grid colours (`cfh/relink-containers`), plus the `:media`
|
||||
collection keys and library-color `:image` ids. It is the same surface
|
||||
`binfile.common/process-file` remaps when it copies a file. The
|
||||
document's own `:id` and its `:tokens-source` are rewritten too, so a
|
||||
document moved into another file's id space names that file as itself,
|
||||
@ -1115,8 +1114,7 @@
|
||||
(-> data
|
||||
(d/update-when :id #(if (uuid? %) (lookup %) %))
|
||||
(d/update-when :tokens-source lookup)
|
||||
(d/update-when :pages-index #(cfh/relink-refs % lookup))
|
||||
(d/update-when :components #(cfh/relink-refs % lookup))
|
||||
(cfh/relink-containers lookup)
|
||||
(d/update-when :media
|
||||
(fn [media]
|
||||
(reduce-kv (fn [res k v]
|
||||
@ -1137,28 +1135,17 @@
|
||||
colors
|
||||
colors)))))))
|
||||
|
||||
(def ^:private reference-attrs
|
||||
"Shape attrs whose value IS a reference to the file that owns the entity.
|
||||
`relink-refs` finds them inside a shape map, where the attr and the value
|
||||
travel together. An operation that sets one of them carries the id alone."
|
||||
#{:component-file :fill-color-ref-file :stroke-color-ref-file :typography-ref-file})
|
||||
|
||||
(defn- remap-op
|
||||
"Rewrite the reference of one `:mod-obj` operation through `id-map`.
|
||||
`shape-set-ops` emits one `:set` per differing attr, so a reference can
|
||||
arrive either as the attr's own value or, for an image shape, as the media
|
||||
map under `:metadata`."
|
||||
[op id-map]
|
||||
(let [attr (:attr op)
|
||||
val (:val op)]
|
||||
(cond
|
||||
(and (contains? reference-attrs attr) (uuid? val))
|
||||
(assoc op :val (get id-map val val))
|
||||
|
||||
(and (= :metadata attr) (uuid? (:id val)))
|
||||
(assoc op :val (update val :id #(get id-map % %)))
|
||||
|
||||
:else op)))
|
||||
"Rewrite the references of one `:mod-obj` operation through `lookup`.
|
||||
`shape-set-ops` emits one `:set` per differing attr, so the value is
|
||||
relinked as that attr of a shape: a reference arrives as the attr's own
|
||||
value (`:component-file`) or nested in it (`:fills`, `:metadata`, …)."
|
||||
[{:keys [attr val] :as op} lookup]
|
||||
(if (and (= :set (:type op)) (some? val))
|
||||
(let [shape {attr val}
|
||||
shape' (cfh/relink-shape shape lookup)]
|
||||
(if (identical? shape shape') op (assoc op :val (get shape' attr))))
|
||||
op))
|
||||
|
||||
(defn remap-changes
|
||||
"Rewrite the cross-file references of a change vector through `id-map`,
|
||||
@ -1168,41 +1155,66 @@
|
||||
fill whose `:fill-color-ref-file` names another file loses its link, and so
|
||||
does an instance whose `:component-file` does.
|
||||
|
||||
Every payload `compute-changes` can emit is covered. `relink-refs` walks a
|
||||
whole map, so `:obj`, `:page`, `:params`, and a component's `:objects` are
|
||||
complete on their own. The payloads it cannot see are the values that ARE
|
||||
the reference: a media object's `:id` (its `:media-id` is a storage key and
|
||||
must not be touched), a library color's `:image` id, a `:del-media`'s
|
||||
top-level `:id`, a `:set-tokens-source`'s `:library-id`, and an operation
|
||||
value that is the reference itself. A `:set-tokens-source`'s `:file-id` is
|
||||
a `:file-id` key, which `relink-refs` rewrites. The top-level `:id` of the
|
||||
other delete changes (`:del-color`, `:del-typography`, `:del-component`,
|
||||
`:del-obj`, `:del-page`) is NOT such a value: those name entities the two
|
||||
files share by id, never a media row, so they are left alone — only a
|
||||
media id or the file id is ever a key of `id-map`. The other token changes
|
||||
are left alone: no id in `id-map` is a token id."
|
||||
Each change type that can carry a reference is relinked where it does:
|
||||
|
||||
- `:add-obj`: the `:obj` shape (`cfh/relink-shape`);
|
||||
- `:mod-obj`: the value of each `:set` operation (`remap-op`);
|
||||
- `:add-page`: the `:page`, its shapes and default grids
|
||||
(`cfh/relink-page`);
|
||||
- `:set-default-grid`: the grid colour of `:params`
|
||||
(`cfh/relink-grid-params`);
|
||||
- `:add-component`, `:mod-component`: the `:objects` a deleted
|
||||
component keeps (`cfh/relink-objects`);
|
||||
- `:add-color`, `:mod-color`: the library color's `:image` id;
|
||||
- `:add-media`, `:mod-media`: the media object's `:id` and `:file-id`
|
||||
(its `:media-id` is a storage key and must not be touched);
|
||||
- `:del-media`: the top-level `:id`;
|
||||
- `:set-tokens-source`: `:file-id` and `:library-id`.
|
||||
|
||||
The top-level `:id` of the other delete changes (`:del-color`,
|
||||
`:del-typography`, `:del-component`, `:del-obj`, `:del-page`) is left
|
||||
alone: those name entities the two files share by id, never a media
|
||||
row, and only a media id or the file id is ever a key of `id-map`. The
|
||||
token changes are left alone too: no id in `id-map` is a token id."
|
||||
[changes id-map]
|
||||
(if (empty? id-map)
|
||||
changes
|
||||
(let [lookup #(get id-map % %)
|
||||
relink #(cfh/relink-refs % lookup)]
|
||||
(let [lookup #(get id-map % %)]
|
||||
(mapv (fn [change]
|
||||
(cond-> (relink change)
|
||||
(= :del-media (:type change))
|
||||
(update :id lookup)
|
||||
(case (:type change)
|
||||
:add-obj
|
||||
(d/update-when change :obj cfh/relink-shape lookup)
|
||||
|
||||
(uuid? (:id (:object change)))
|
||||
(update-in [:object :id] lookup)
|
||||
:mod-obj
|
||||
(d/update-when change :operations
|
||||
(fn [ops] (mapv #(remap-op % lookup) ops)))
|
||||
|
||||
(and (= :set-tokens-source (:type change))
|
||||
(uuid? (:library-id change)))
|
||||
(update :library-id lookup)
|
||||
:add-page
|
||||
(d/update-when change :page cfh/relink-page lookup)
|
||||
|
||||
(uuid? (get-in change [:color :image :id]))
|
||||
(update-in [:color :image :id] lookup)
|
||||
:set-default-grid
|
||||
(d/update-when change :params cfh/relink-grid-params lookup)
|
||||
|
||||
(seq (:operations change))
|
||||
(update :operations #(mapv (fn [op] (remap-op op id-map)) %))))
|
||||
(:add-component :mod-component)
|
||||
(d/update-when change :objects cfh/relink-objects lookup)
|
||||
|
||||
(:add-color :mod-color)
|
||||
(d/update-in-when change [:color :image :id] lookup)
|
||||
|
||||
(:add-media :mod-media)
|
||||
(-> change
|
||||
(d/update-in-when [:object :id] lookup)
|
||||
(d/update-in-when [:object :file-id] lookup))
|
||||
|
||||
:del-media
|
||||
(d/update-when change :id lookup)
|
||||
|
||||
:set-tokens-source
|
||||
(-> change
|
||||
(d/update-when :file-id lookup)
|
||||
(d/update-when :library-id lookup))
|
||||
|
||||
change))
|
||||
changes))))
|
||||
|
||||
(defn- strip-modified-at
|
||||
|
||||
@ -656,91 +656,172 @@
|
||||
(into xform:collect-media-refs (vals (:components data)))
|
||||
(into (keys (:media data)))))
|
||||
|
||||
(defn relink-refs
|
||||
"A function responsible to analyze the file data or shape for references
|
||||
and apply lookup-index on it.
|
||||
(def shape-ref-paths
|
||||
"Every place a shape holds a reference to another file (`:file`) or to
|
||||
a media object (`:media`) at the current data version.
|
||||
|
||||
It visits every map in `data` but rebuilds a collection only when
|
||||
something inside it changed: a branch derive runs it over the whole
|
||||
document on every read, and a copying walk spent seconds on a file of
|
||||
90,000 shapes where most shapes hold no reference at all."
|
||||
[data lookup-index]
|
||||
(letfn [(relink-key [form k]
|
||||
(let [v (get form k)
|
||||
v' (lookup-index v)]
|
||||
(if (= v v') form (assoc form k v'))))
|
||||
`:path` is relative to the shape. A keyword step is a map key, `:*`
|
||||
steps into every element of a vector, and `::tree` stands for the node
|
||||
and every descendant reached through `:children` (the text `:content`
|
||||
tree). The last step names the key holding the uuid.
|
||||
|
||||
(relink-id-in [form k]
|
||||
(let [inner (get form k)
|
||||
inner' (relink-key inner :id)]
|
||||
(if (identical? inner inner') form (assoc form k inner'))))
|
||||
The shape schema declares every path, and
|
||||
`common-tests.files-ref-paths-test` fails when the schema gains a uuid
|
||||
path that is neither listed here nor classified as no reference."
|
||||
[{:path [:component-file] :kind :file}
|
||||
{:path [:metadata :id] :kind :media}
|
||||
{:path [:fills :* :fill-color-ref-file] :kind :file}
|
||||
{:path [:fills :* :fill-image :id] :kind :media}
|
||||
{:path [:strokes :* :stroke-color-ref-file] :kind :file}
|
||||
{:path [:strokes :* :stroke-image :id] :kind :media}
|
||||
{:path [:shadow :* :color :ref-file] :kind :file}
|
||||
{:path [:grids :* :params :color :ref-file] :kind :file}
|
||||
{:path [:content ::tree :fills :* :fill-color-ref-file] :kind :file}
|
||||
{:path [:content ::tree :fills :* :fill-image :id] :kind :media}
|
||||
{:path [:content ::tree :typography-ref-file] :kind :file}
|
||||
{:path [:position-data :* :fills :* :fill-color-ref-file] :kind :file}
|
||||
{:path [:position-data :* :fills :* :fill-image :id] :kind :media}])
|
||||
|
||||
(process-map-form [form]
|
||||
(cond-> form
|
||||
;; Relink image shapes
|
||||
(and (map? (:metadata form))
|
||||
(= :image (:type form)))
|
||||
(relink-id-in :metadata)
|
||||
(def legacy-shape-ref-paths
|
||||
"References in places older data versions used, in the format of
|
||||
`shape-ref-paths`. Binfile import relinks before it migrates, because
|
||||
the migrations resolve `:component-file` against the importing file's
|
||||
libraries, so it can meet any of them:
|
||||
|
||||
;; Relink paths with fill image
|
||||
(map? (:fill-image form))
|
||||
(relink-id-in :fill-image)
|
||||
- top-level fill and stroke colour refs, moved into `:fills` and
|
||||
`:strokes` by migration `legacy-16`, which skips text shapes;
|
||||
- a top-level `:fill-image`, once set on many shape types;
|
||||
- the shadow and grid colour `:file-id`, renamed `:ref-file` by
|
||||
migration `0015-clean-shadow-color`;
|
||||
- text nodes holding fill attrs directly, moved into `:fills` by
|
||||
migration `0006-fix-old-texts-fills`."
|
||||
[{:path [:fill-color-ref-file] :kind :file}
|
||||
{:path [:stroke-color-ref-file] :kind :file}
|
||||
{:path [:fill-image :id] :kind :media}
|
||||
{:path [:shadow :* :color :file-id] :kind :file}
|
||||
{:path [:grids :* :params :color :file-id] :kind :file}
|
||||
{:path [:content ::tree :fill-color-ref-file] :kind :file}])
|
||||
|
||||
(map? (:stroke-image form))
|
||||
(relink-id-in :stroke-image)
|
||||
(defn- relink-vector
|
||||
"Apply `f` to every element of vector `v`, rebuilding it only when an
|
||||
element changed."
|
||||
[v f lookup]
|
||||
(reduce-kv (fn [acc i x]
|
||||
(let [x' (f x lookup)]
|
||||
(if (identical? x x') acc (assoc acc i x'))))
|
||||
v
|
||||
v))
|
||||
|
||||
;; This covers old shapes and the new :fills.
|
||||
(uuid? (:fill-color-ref-file form))
|
||||
(relink-key :fill-color-ref-file)
|
||||
(defn- relink-vals
|
||||
"Apply `f` to every value of map `m`, rebuilding it only when a value
|
||||
changed."
|
||||
[m f lookup]
|
||||
(reduce-kv (fn [acc k x]
|
||||
(let [x' (f x lookup)]
|
||||
(if (identical? x x') acc (assoc acc k x'))))
|
||||
m
|
||||
m))
|
||||
|
||||
;; This covers the old shapes and the new :strokes
|
||||
(uuid? (:stroke-color-ref-file form))
|
||||
(relink-key :stroke-color-ref-file)
|
||||
(defn- paths->trie
|
||||
"Merge `paths` into a nested map step -> subtrie, `::leaf` at the key
|
||||
holding the uuid."
|
||||
[paths]
|
||||
(reduce (fn [trie path]
|
||||
(assert (not= ::leaf (get-in trie (pop path)))
|
||||
(str "ref path under another: " path))
|
||||
(assert (not (map? (get-in trie path)))
|
||||
(str "ref path ends inside another: " path))
|
||||
(assoc-in trie path ::leaf))
|
||||
{}
|
||||
paths))
|
||||
|
||||
;; This covers all text shapes that have typography referenced
|
||||
(uuid? (:typography-ref-file form))
|
||||
(relink-key :typography-ref-file)
|
||||
(defn- compile-trie
|
||||
"Compile a trie of ref paths into `(fn [node lookup] node')`, which
|
||||
rebuilds only what changed."
|
||||
[trie]
|
||||
(let [fs (mapv (fn [[k sub]]
|
||||
(cond
|
||||
(= ::leaf sub)
|
||||
(fn [node lookup]
|
||||
(let [v (get node k)]
|
||||
(if (uuid? v)
|
||||
(let [v' (lookup v)]
|
||||
(if (= v v') node (assoc node k v')))
|
||||
node)))
|
||||
|
||||
;; This covers the component instance links
|
||||
(uuid? (:component-file form))
|
||||
(relink-key :component-file)
|
||||
(= :* k)
|
||||
(let [f (compile-trie sub)]
|
||||
(fn [coll lookup]
|
||||
(if (vector? coll) (relink-vector coll f lookup) coll)))
|
||||
|
||||
;; This covers the shadows and grids: their colour names the
|
||||
;; library in `:ref-file` (migration 0015 renamed the legacy
|
||||
;; `:file-id`, still relinked for unmigrated data)
|
||||
(uuid? (:ref-file form))
|
||||
(relink-key :ref-file)
|
||||
(= ::tree k)
|
||||
(let [f (compile-trie sub)]
|
||||
(fn walk [node lookup]
|
||||
(let [node (f node lookup)
|
||||
children (get node :children)]
|
||||
(if (vector? children)
|
||||
(let [children' (relink-vector children walk lookup)]
|
||||
(if (identical? children children')
|
||||
node
|
||||
(assoc node :children children')))
|
||||
node))))
|
||||
|
||||
(uuid? (:file-id form))
|
||||
(relink-key :file-id)))
|
||||
:else
|
||||
(let [f (compile-trie sub)]
|
||||
(fn [node lookup]
|
||||
(let [v (get node k)]
|
||||
(if (nil? v)
|
||||
node
|
||||
(let [v' (f v lookup)]
|
||||
(if (identical? v v') node (assoc node k v')))))))))
|
||||
trie)]
|
||||
(fn [node lookup]
|
||||
(reduce (fn [node f] (f node lookup)) node fs))))
|
||||
|
||||
(walk-children [form]
|
||||
(cond
|
||||
(or (map? form) (vector? form))
|
||||
(reduce-kv (fn [acc k v]
|
||||
(let [v' (walk v)]
|
||||
(if (identical? v v') acc (assoc acc k v'))))
|
||||
form
|
||||
form)
|
||||
(def ^:private relink-shape*
|
||||
(->> (concat shape-ref-paths legacy-shape-ref-paths)
|
||||
(map :path)
|
||||
(paths->trie)
|
||||
(compile-trie)))
|
||||
|
||||
(coll? form)
|
||||
(let [items (map walk form)]
|
||||
(cond
|
||||
(every? true? (map identical? form items)) form
|
||||
(list? form) (apply list items)
|
||||
(seq? form) (doall items)
|
||||
:else (into (empty form) items)))
|
||||
(defn relink-shape
|
||||
"Rewrite every reference `shape-ref-paths` and `legacy-shape-ref-paths`
|
||||
name through `lookup` (uuid -> uuid, identity for unknown ids).
|
||||
Returns `shape` itself when nothing changed."
|
||||
[shape lookup]
|
||||
(relink-shape* shape lookup))
|
||||
|
||||
:else
|
||||
form))
|
||||
(defn relink-objects
|
||||
"`relink-shape` over every shape of an objects map. Returns `objects`
|
||||
itself when nothing changed."
|
||||
[objects lookup]
|
||||
(relink-vals objects relink-shape* lookup))
|
||||
|
||||
(walk [form]
|
||||
(let [form (walk-children form)]
|
||||
(if (map? form)
|
||||
(process-map-form form)
|
||||
form)))]
|
||||
(def relink-grid-params
|
||||
"`(fn [params lookup])`: relink the colour of one grid's params, its
|
||||
`:ref-file` or the legacy `:file-id` (see `legacy-shape-ref-paths`).
|
||||
Returns `params` itself when nothing changed."
|
||||
(compile-trie (paths->trie [[:color :ref-file] [:color :file-id]])))
|
||||
|
||||
(walk data)))
|
||||
(defn relink-page
|
||||
"Relink the references of a page through `lookup`: its shapes and the
|
||||
colours of its default grids, also under `:options :saved-grids`, where
|
||||
they lived before migration `legacy-55` moved them."
|
||||
[page lookup]
|
||||
(let [relink-grids #(relink-vals %1 relink-grid-params %2)]
|
||||
(-> page
|
||||
(d/update-when :objects relink-objects lookup)
|
||||
(d/update-when :default-grids relink-grids lookup)
|
||||
(d/update-in-when [:options :saved-grids] relink-grids lookup))))
|
||||
|
||||
(defn relink-containers
|
||||
"Relink the references of every page and component of file `data`
|
||||
through `lookup`. Leaves the `:media` and `:colors` collections alone."
|
||||
[data lookup]
|
||||
(let [relink-component #(d/update-when %1 :objects relink-objects %2)]
|
||||
(-> data
|
||||
(d/update-when :pages-index relink-vals relink-page lookup)
|
||||
(d/update-when :components relink-vals relink-component lookup))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SHAPES ORGANIZATION
|
||||
|
||||
@ -17,7 +17,10 @@
|
||||
(def schema:grid-color
|
||||
[:map {:title "GridColor"}
|
||||
[:color clr/schema:hex-color]
|
||||
[:opacity ::sm/safe-number]])
|
||||
[:opacity ::sm/safe-number]
|
||||
;; library colour the grid follows, as `attach-grid-color` writes it
|
||||
[:ref-id {:optional true} ::sm/uuid]
|
||||
[:ref-file {:optional true} ::sm/uuid]])
|
||||
|
||||
(def schema:grid-count
|
||||
[:and {:gen/gen (sg/small-double :min 1)}
|
||||
|
||||
@ -306,7 +306,12 @@
|
||||
:s2 {:id :s2 :component-file ext-lib}
|
||||
:s3 {:id :s3}
|
||||
:s4 {:id :s4 :fill-color-ref-file branch-id
|
||||
:typography-ref-file branch-id}
|
||||
:content {:type "root"
|
||||
:children [{:type "paragraph-set"
|
||||
:children [{:type "paragraph"
|
||||
:typography-ref-file branch-id
|
||||
:children [{:text "x"
|
||||
:typography-ref-file branch-id}]}]}]}}
|
||||
:s5 {:id :s5 :type :image :metadata {:id media-old}
|
||||
:fill-image {:id media-old}}})
|
||||
(assoc :media {media-old {:id media-old :name "img"}})
|
||||
@ -318,7 +323,8 @@
|
||||
(t/is (= ext-lib (get-in objs [:s2 :component-file])))
|
||||
(t/is (not (contains? (get objs :s3) :component-file)))
|
||||
(t/is (= main-id (get-in objs [:s4 :fill-color-ref-file])))
|
||||
(t/is (= main-id (get-in objs [:s4 :typography-ref-file])))
|
||||
(t/is (= main-id (get-in objs [:s4 :content :children 0 :children 0 :typography-ref-file])))
|
||||
(t/is (= main-id (get-in objs [:s4 :content :children 0 :children 0 :children 0 :typography-ref-file])))
|
||||
(t/is (= media-new (get-in objs [:s5 :metadata :id])))
|
||||
(t/is (= media-new (get-in objs [:s5 :fill-image :id])))
|
||||
(t/is (= {media-new {:id media-new :name "img"}} (:media data')))
|
||||
@ -1320,7 +1326,7 @@
|
||||
;; plus the fresh ids of the copied rows). Of the change types
|
||||
;; `compute-changes` emits with a top-level `:id`, only `:del-media`'s
|
||||
;; names a media object, a reference through that map; its `:id` is the
|
||||
;; whole payload and `relink-refs` cannot see it. The others name
|
||||
;; whole payload and no shape relink can see it. The others name
|
||||
;; entities the two files share by id (colour, typography, component,
|
||||
;; shape, page), never a media row, so they must come out untouched —
|
||||
;; re-pointing one through a media-pair map would corrupt it.
|
||||
|
||||
269
common/test/common_tests/files_ref_paths_test.cljc
Normal file
269
common/test/common_tests/files_ref_paths_test.cljc
Normal file
@ -0,0 +1,269 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS SUBSIDIARY SL
|
||||
|
||||
(ns common-tests.files-ref-paths-test
|
||||
"Safety net for `cfh/shape-ref-paths`: every uuid the shape schema
|
||||
declares is either a file or media reference listed there, or a
|
||||
non-reference listed here."
|
||||
(:require
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.set :as set]
|
||||
[clojure.test :as t]
|
||||
[malli.core :as m]))
|
||||
|
||||
;; Path steps beyond the `cfh/shape-ref-paths` language. They name
|
||||
;; places a reference spec cannot reach today, so a uuid found under
|
||||
;; one always fails classification until the language grows.
|
||||
;; ::set every element of a set
|
||||
;; ::keys every key of a map-of
|
||||
;; ::vals every value of a map-of
|
||||
|
||||
(def ^:private uuid-types
|
||||
#{::sm/uuid :uuid})
|
||||
|
||||
(defn- collapse-text-tree
|
||||
"Replace each run of `:children :*` steps with `::cfh/tree`. The text
|
||||
content schema spells its three levels out; the reference spec walks
|
||||
them as one recursive tree."
|
||||
[path]
|
||||
(loop [in (seq path)
|
||||
out []]
|
||||
(if-let [[step & more] in]
|
||||
(if (and (= :children step) (= :* (first more)))
|
||||
(recur (next more) (if (= ::cfh/tree (peek out)) out (conj out ::cfh/tree)))
|
||||
(recur more (conj out step)))
|
||||
out)))
|
||||
|
||||
(defn- schema-uuid-paths
|
||||
"All paths under `schema` whose value schema is a uuid. Throws on a
|
||||
container type the walk does not know, so a new one cannot hide a
|
||||
uuid. A ref met again inside its own subtree stops the walk there."
|
||||
[schema]
|
||||
(letfn [(walk [s path seen]
|
||||
(let [form (when (sm/ref? s) (m/form s))]
|
||||
(when-not (and form (contains? seen form))
|
||||
(let [seen (cond-> seen form (conj form))
|
||||
s (m/deref-all s)
|
||||
type (m/type s)]
|
||||
(cond
|
||||
(contains? uuid-types type)
|
||||
[path]
|
||||
|
||||
(= :map type)
|
||||
(mapcat (fn [[k _ child]] (walk child (conj path k) seen))
|
||||
(m/children s))
|
||||
|
||||
(= :multi type)
|
||||
(mapcat (fn [[_ _ child]] (walk child path seen))
|
||||
(m/children s))
|
||||
|
||||
(contains? #{:and :or :maybe} type)
|
||||
(mapcat #(walk % path seen) (m/children s))
|
||||
|
||||
(contains? #{:vector :sequential} type)
|
||||
(walk (first (m/children s)) (conj path :*) seen)
|
||||
|
||||
(= :set type)
|
||||
(walk (first (m/children s)) (conj path ::set) seen)
|
||||
|
||||
(= :map-of type)
|
||||
(let [[ks vs] (m/children s)]
|
||||
(concat (walk ks (conj path ::keys) seen)
|
||||
(walk vs (conj path ::vals) seen)))
|
||||
|
||||
(some m/schema? (m/children s))
|
||||
(throw (ex-info "unhandled schema type in uuid inventory"
|
||||
{:type type :path path}))
|
||||
|
||||
:else
|
||||
nil)))))]
|
||||
(->> (walk (sm/schema schema) [] #{})
|
||||
(map collapse-text-tree)
|
||||
(distinct)
|
||||
(vec))))
|
||||
|
||||
(def ^:private inventory
|
||||
(delay (schema-uuid-paths cts/schema:shape)))
|
||||
|
||||
(def ^:private non-reference-paths
|
||||
"Uuid paths that name no file and no media row; relinking keeps them."
|
||||
#{;; identity
|
||||
[:id]
|
||||
;; tree
|
||||
[:parent-id]
|
||||
[:frame-id]
|
||||
[:page-id]
|
||||
[:shapes :*]
|
||||
;; component
|
||||
[:component-id]
|
||||
[:shape-ref]
|
||||
[:variant-id]
|
||||
;; asset: colour or typography id inside its library
|
||||
[:fills :* :fill-color-ref-id]
|
||||
[:strokes :* :stroke-color-ref-id]
|
||||
[:shadow :* :color :ref-id]
|
||||
[:grids :* :params :color :ref-id]
|
||||
[:content ::cfh/tree :fills :* :fill-color-ref-id]
|
||||
[:content ::cfh/tree :typography-ref-id]
|
||||
[:position-data :* :fills :* :fill-color-ref-id]
|
||||
;; effect
|
||||
[:shadow :* :id]
|
||||
[:blur :id]
|
||||
[:background-blur :id]
|
||||
;; prototype
|
||||
[:interactions :* :destination]
|
||||
[:interactions :* :position-relative-to]
|
||||
;; layout
|
||||
[:layout-grid-cells ::keys]
|
||||
[:layout-grid-cells ::vals :id]
|
||||
[:layout-grid-cells ::vals :shapes :*]})
|
||||
|
||||
(defn- unclassified-paths
|
||||
[paths ref-specs]
|
||||
(let [known (into non-reference-paths (map :path) ref-specs)]
|
||||
(vec (remove known paths))))
|
||||
|
||||
(defn- stale-paths
|
||||
[paths ref-specs]
|
||||
(let [found (set paths)]
|
||||
(->> ref-specs
|
||||
(map :path)
|
||||
(remove found)
|
||||
(vec))))
|
||||
|
||||
(t/deftest every-schema-uuid-is-classified
|
||||
(let [missing (unclassified-paths @inventory cfh/shape-ref-paths)]
|
||||
(t/is (empty? missing)
|
||||
(str "Unclassified uuid paths in the shape schema: " (pr-str missing)
|
||||
". Add each path to `cfh/shape-ref-paths` if it names a file or"
|
||||
" a media row, else to `non-reference-paths` in this test."))))
|
||||
|
||||
(t/deftest every-ref-path-is-in-schema
|
||||
(let [stale (stale-paths @inventory cfh/shape-ref-paths)]
|
||||
(t/is (empty? stale)
|
||||
(str "`cfh/shape-ref-paths` entries absent from the shape schema: "
|
||||
(pr-str stale)
|
||||
". Fix the path, or move it to `cfh/legacy-shape-ref-paths`."))))
|
||||
|
||||
(t/deftest non-reference-paths-are-in-schema
|
||||
(let [found (set @inventory)]
|
||||
(t/is (empty? (remove found non-reference-paths)))))
|
||||
|
||||
;; Behaviour
|
||||
|
||||
(defn- locate
|
||||
"Values at `path` in `x`, one per concrete location."
|
||||
[x path]
|
||||
(if-let [[step & more] (seq path)]
|
||||
(cond
|
||||
(= :* step)
|
||||
(when (sequential? x) (mapcat #(locate % more) x))
|
||||
|
||||
(= ::set step)
|
||||
(when (set? x) (mapcat #(locate % more) x))
|
||||
|
||||
(= ::keys step)
|
||||
(when (map? x) (mapcat #(locate % more) (keys x)))
|
||||
|
||||
(= ::vals step)
|
||||
(when (map? x) (mapcat #(locate % more) (vals x)))
|
||||
|
||||
(= ::cfh/tree step)
|
||||
(when (map? x) (mapcat #(locate % more) (tree-seq map? :children x)))
|
||||
|
||||
:else
|
||||
(when (map? x)
|
||||
(when-some [v (get x step)] (locate v more))))
|
||||
[x]))
|
||||
|
||||
(defn- plant
|
||||
"Set a value from `next-id` at every location of `path` in `x`.
|
||||
Missing maps and vectors on the way are created with one element,
|
||||
so every shape type carries every reference; a non-map where the
|
||||
path wants a map (a path shape's binary `:content`) is left alone."
|
||||
[x path next-id]
|
||||
(let [[step & more] path]
|
||||
(cond
|
||||
(= :* step)
|
||||
(cond
|
||||
(nil? x) [(plant nil more next-id)]
|
||||
(vector? x) (mapv #(plant % more next-id) x)
|
||||
:else x)
|
||||
|
||||
(= ::cfh/tree step)
|
||||
(letfn [(node [n]
|
||||
(let [n (plant n more next-id)]
|
||||
(cond-> n
|
||||
(vector? (:children n)) (update :children #(mapv node %)))))]
|
||||
(if (or (nil? x) (map? x)) (node x) x))
|
||||
|
||||
(nil? x)
|
||||
(plant {} path next-id)
|
||||
|
||||
(not (map? x))
|
||||
x
|
||||
|
||||
(empty? more)
|
||||
(assoc x step (next-id))
|
||||
|
||||
:else
|
||||
(assoc x step (plant (get x step) more next-id)))))
|
||||
|
||||
(def ^:private all-ref-paths
|
||||
(delay (into (mapv :path cfh/shape-ref-paths)
|
||||
(map :path)
|
||||
cfh/legacy-shape-ref-paths)))
|
||||
|
||||
(defn- uuids-at
|
||||
[shape paths]
|
||||
(into #{} (comp (mapcat #(locate shape %)) (filter uuid?)) paths))
|
||||
|
||||
(def ^:private generated-shapes
|
||||
(delay
|
||||
(let [gen (sg/generator cts/schema:shape)]
|
||||
(mapv #(sg/generate gen {:seed % :size 10}) (range 60)))))
|
||||
|
||||
(t/deftest relink-shape-rewrites-refs-only
|
||||
(let [ref-paths @all-ref-paths
|
||||
planted (mapv (fn [shape]
|
||||
(reduce #(plant %1 %2 uuid/next) shape ref-paths))
|
||||
@generated-shapes)]
|
||||
(t/testing "every ref path is exercised"
|
||||
(let [hit (into #{}
|
||||
(mapcat (fn [shape]
|
||||
(filter #(some uuid? (locate shape %)) ref-paths)))
|
||||
planted)]
|
||||
(t/is (empty? (remove hit ref-paths)))))
|
||||
|
||||
(doseq [shape planted]
|
||||
(let [scanned (into ref-paths @inventory)
|
||||
old-refs (uuids-at shape ref-paths)
|
||||
renames (into {}
|
||||
(map (fn [id] [id (uuid/next)]))
|
||||
(uuids-at shape scanned))
|
||||
lookup #(get renames % %)
|
||||
result (cfh/relink-shape shape lookup)]
|
||||
(t/testing (str (:type shape) " " (:id shape))
|
||||
(t/is (empty? (set/intersection old-refs (uuids-at result scanned)))
|
||||
"no planted id remains")
|
||||
(t/is (empty? (remove #(= (mapv lookup (locate shape %))
|
||||
(vec (locate result %)))
|
||||
ref-paths))
|
||||
"ref paths not rewritten through lookup")
|
||||
(t/is (empty? (remove #(= (vec (locate shape %))
|
||||
(vec (locate result %)))
|
||||
non-reference-paths))
|
||||
"non-reference paths changed")
|
||||
(let [same (identical? shape (cfh/relink-shape shape identity))]
|
||||
(t/is same "identity lookup returns the input object")))))))
|
||||
|
||||
(t/deftest relink-objects-preserves-identity
|
||||
(let [objects (into {} (map (juxt :id identity)) @generated-shapes)]
|
||||
(t/is (identical? objects (cfh/relink-objects objects identity)))))
|
||||
@ -24,6 +24,7 @@
|
||||
[common-tests.files-migrations-0025-test]
|
||||
[common-tests.files-migrations-0026-test]
|
||||
[common-tests.files-migrations-test]
|
||||
[common-tests.files-ref-paths-test]
|
||||
[common-tests.files.comp-processors-test]
|
||||
[common-tests.files.helpers-test]
|
||||
[common-tests.files.repair-test]
|
||||
@ -131,6 +132,7 @@
|
||||
'common-tests.files-migrations-0025-test
|
||||
'common-tests.files-migrations-0026-test
|
||||
'common-tests.files-migrations-test
|
||||
'common-tests.files-ref-paths-test
|
||||
'common-tests.files.comp-processors-test
|
||||
'common-tests.files.helpers-test
|
||||
'common-tests.files.repair-test
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user