diff --git a/.serena/memories/common/component-sync-contract.md b/.serena/memories/common/component-sync-contract.md index ef35d0998c..3d47742f76 100644 --- a/.serena/memories/common/component-sync-contract.md +++ b/.serena/memories/common/component-sync-contract.md @@ -27,7 +27,10 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w - Reset: the selected head's subtree becomes equal to its near main (expected geometry); all its touched groups cleared, `:swap-group` included: a swapped head turns back into the near main's component in place, keeping its id. Nothing outside that subtree changes. - Update main (from a top copy head): the copy's differing values go to the main; the copy's touched cleared; other copies then sync and keep their own overrides. A swapped child replaces the main child it stands for, and neither keeps `:swap-group`. The main's authored groups are unioned with the copy's even on a repeated update; `:remote-synced` records an earlier update and must never clear those groups (F114). - Detach: the subtree loses component links, `:touched`, `:remote-synced`. First-level nested heads stay copies, move one nesting level up and inherit the near main's touched groups, so values their old near main overrode become overrides. A swapped head left with no enclosing copy becomes a plain copy of its own component (`:shape-ref` = its main root, no `:swap-group`). +- Direct content sync of a swapped head leaves its placement attributes and their tokens alone (F216). The enclosing main supplies constraints, fixed-scroll and layout item attributes; syncing either source first must give the same result. +- Reheading a swapped child on detach or clipboard copy retains placement that differs from its own content main as placement overrides (F217). Compare constraints with implicit defaults in the destination context, and fixed-scroll as a boolean; equal placement does not create groups. - Instantiate / nest a copy: the new subtree has no touched groups. +- Relocate into a blocked parent: the move also locks each moved root (`generate-relocate`). A copy root whose blocked value changes gains `:modifiable-group`; predict this from the destination before the move, rather than reading the resulting touched set. - Duplicate a copy: the new subtree keeps the source's values and touched; if its nesting level changes, touched is inherited as in detach. Paste and move out of a copy follow the same rule. - Swap without keep-touched: the new subtree keeps `swap-keep-attrs` values; the new head keeps the old shape's id. A retained rotation or flip that differs from the new component's expected placement becomes a `:geometry-group` override so later sync preserves it, including orientation inherited from the old component. The swap authors that choice. Size-only overrides clear. Orientation inherited from the position source or the parent stays untouched, including references into deleted mains (F154). Other content overrides clear. Inside a copy it keeps the old `:shape-ref` and gets `:swap-group` (none when the new component is the near main's); inside a main it is a plain nested copy. Swapping back produces a clean copy of the near position, including its content overrides, without authoring new groups (F176). Sync through the enclosing copy that owns the new refs; direct sync from the chosen component skips those indirect refs. @@ -40,7 +43,7 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w - A text is letters (with line breaks) and a style per letter, all in `:content`. Its groups: `:text-content-text` (letters and line breaks) and one per style unit: `-family` (family, font id), `-weight` (weight, style, variant id), `-size`, `-line-height`, `-spacing`, `-decoration`, `-case`, `-fills`, `-typography` (typography reference), `-align`, `-direction` (paragraphs), `-valign` (root). Any of them implies `:content-group`. Splitting runs by styling is a style change, never a text override; an override covers the whole text, not single letters. - Touch: compare old and new content. Letters differ -> `:text-content-text`. A style unit is touched when a shared letter changes its value or, if the letters changed, when a value appears that the text did not have (typed letters take a neighbour's style and touch nothing). A token on the copy touches the units of the attributes it sets. - Merge (sync, and switch with the carried units): letters from the copy if overridden, else from the main. Each unit from the copy if overridden, else from the main (the source), placed on the result letters: (1) a source with one value across the text applies to every letter; (2) else letters both texts share (stretches of 3+ equal letters, by a letter diff) take the source's value; (3) else the value of the letter before, across line breaks; letters at the start take the first shared letter after them; with nothing shared, the source's first letter. Paragraph units follow the paragraph of the first shared letter, else the paragraph before. Adjacent runs with equal styles join. -- Typography reference: kept on the result only when every unit the typography sets comes from the same side as the reference; a run that loses it still follows typography updates through its main. +- Typography reference: kept on the result only when every unit the typography sets comes from the same side as the reference; a run that loses it still follows typography updates through its main. Applying a typography explicitly authors its reference and all six style units (family, weight, size, line height, spacing, case), including equal values and reapplication of an inherited asset. This differs from a raw content edit, which touches only changed units. - Family and weight from different sides: sync keeps the weight side's variant id; the frontend then picks the closest variant of the family. - Library color and typography syncs are derived writes: they never touch. @@ -85,3 +88,9 @@ anchor when the replaced position and swap content have different sizes. Apply the main's nonlocal changes to its own file, settle changed placement, and append those changes to the same inverse-sync group. Keep the source copy's local changes routed separately, including for linked libraries. + +Detach settles inherited placement for surviving swapped heads whose +position references advance to another frame (F219). A rotated head's old +and new position frames can have different dimensions. Correct the head +and children in detach's own undo group, without pulling content from the +new reference or creating a geometry override. Authored geometry stays. diff --git a/.serena/memories/frontend/composable-component-tests.md b/.serena/memories/frontend/composable-component-tests.md index e29c9ceab1..f82e8d8399 100644 --- a/.serena/memories/frontend/composable-component-tests.md +++ b/.serena/memories/frontend/composable-component-tests.md @@ -252,9 +252,7 @@ synchronously); an async hop without a pending task makes steps resolve early. T `frontend-tests.composable-tests.completion-contract-test` (slowed-down sync via a mocked `dwl/sync-file`), `frontend-tests.data.workspace-sync-barrier-test`. Re-reads `:file` each step so the shared accessors keep working. -WASM-SHAPE IMMUNITY: a test that starts the WASM renderer leaves `cts/wasm-enabled?` on, which -makes every later shape a proxy that leaves out nil and false attributes; `fixture` turns it off -for the composable tests and restores it after, so they run on records in any order. +WASM-SHAPE IMMUNITY: renderer tests can leave `cts/wasm-enabled?` on; `fixture` disables it and restores it afterward, so composable cases use records in any order. Proxy boundary tests opt in explicitly. Fresh proxies retain every Shape base field, including nil flips, matching record construction/dissoc and preserving exact undo (F203). STORE-SWAP IMMUNITY: other test namespaces `set!` `st/state`/`st/stream` and never restore, while the `app.main.refs` lenses stay bound to the ORIGINAL atoms — propagation then dies silently. The interpreter captures the atoms at namespace-load time and re-`set!`s them per variant. diff --git a/common/src/app/common/logic/duplicate.cljc b/common/src/app/common/logic/duplicate.cljc index 62057ae908..2be4167a42 100644 --- a/common/src/app/common/logic/duplicate.cljc +++ b/common/src/app/common/logic/duplicate.cljc @@ -479,8 +479,8 @@ ;; the copy leaves every copy level (ctk/swapped? shape) - (if-let [root-id (cll/swap-content-root-id libraries shape)] - (update objects (:id shape) cli/rehead-swapped root-id) + (if-let [main (ctf/find-content-ref-shape file container libraries shape :include-deleted? true)] + (update objects (:id shape) cli/rehead-swapped main) (detach-copy objects shape)) :else diff --git a/common/src/app/common/logic/instances.cljc b/common/src/app/common/logic/instances.cljc index a4496d89d9..f54f8c150d 100644 --- a/common/src/app/common/logic/instances.cljc +++ b/common/src/app/common/logic/instances.cljc @@ -122,7 +122,16 @@ (let [shape (ctn/get-shape container shape-id)] (cll/shape-log :debug shape-id container :msg "Detach instance" :shape-id shape-id :container (:id container)) - (generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape))))) + (let [changes (generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape))) + objects (pcb/get-objects changes) + advanced (into [] + (filter (fn [id] + (let [before (get-in container [:objects id]) + after (get objects id)] + (and (ctk/swapped? after) + (not= (:shape-ref before) (:shape-ref after)))))) + (cfh/get-children-ids (:objects container) shape-id))] + (cll/generate-sync-advanced-placement changes container libraries advanced)))) (defn- generate-detach-recursive [changes container libraries shape-id first component-root?] @@ -154,16 +163,32 @@ (defn rehead-swapped "Make a swapped head a plain copy of its own component, for when it leaves - every copy level." - [shape root-id] - (-> shape - (assoc :shape-ref root-id) - (ctk/remove-swap-group))) + every copy level. Keep placement inherited from the old position as + overrides when it differs from the new main." + [shape main] + (let [placement-groups (disj cll/placement-groups :geometry-group) + value (fn [source attr] + (case attr + :constraints-h (or (:constraints-h source) (gsh/default-constraints-h shape)) + :constraints-v (or (:constraints-v source) (gsh/default-constraints-v shape)) + :fixed-scroll (boolean (:fixed-scroll source)) + (get source attr))) + groups (into #{} + (keep (fn [attr] + (let [group (ctk/resolve-sync-group (:type shape) attr)] + (when (and (contains? placement-groups group) + (not= (value shape attr) (value main attr))) + group)))) + (keys ctk/sync-attrs))] + (cond-> (-> shape + (assoc :shape-ref (:id main)) + (ctk/remove-swap-group)) + (seq groups) (update :touched (fnil into #{}) groups)))) (defn- generate-rehead-swapped [changes container libraries shape] - (if-let [root-id (cll/swap-content-root-id libraries shape)] - (pcb/update-shapes changes [(:id shape)] #(rehead-swapped % root-id)) + (if-let [main (ctf/find-content-ref-shape nil container libraries shape :include-deleted? true)] + (pcb/update-shapes changes [(:id shape)] #(rehead-swapped % main)) (generate-detach-immediate changes container (:id shape) (atom #{})))) (defn swapped-descendant-ids diff --git a/common/src/app/common/logic/libraries.cljc b/common/src/app/common/logic/libraries.cljc index ff21dee8bc..2b2dad3aeb 100644 --- a/common/src/app/common/logic/libraries.cljc +++ b/common/src/app/common/logic/libraries.cljc @@ -334,9 +334,10 @@ changes))) (defn generate-sync-transformed-placement - "Settle untouched swapped heads carried through a parent turn in the - same change group. Their position frame can have a different size from - their content, so a rigid turn alone does not settle their placement." + "Settle copy descendants after a reflection and untouched swapped heads + after a parent turn, in the transform's change group. Reflection can + leave descendant flip flags in another decomposition; swapped content + can have a different size from its position frame." [changes file libraries page before ids] (let [objects (pcb/get-objects changes) orientation (fn [shape] @@ -344,11 +345,18 @@ (:rotation shape) (boolean (:flip-x shape)) (boolean (:flip-y shape))]) roots (into (d/ordered-set) (keep (fn [id] - (let [shape (get objects id)] - (when (and (ctk/swapped? shape) - (not (ctk/touched-group? shape :geometry-group)) - (not= (orientation (get before id)) (orientation shape))) - (:id (ctn/get-component-shape objects shape)))))) + (let [shape (get objects id) + root (when (:component-id shape) (ctn/get-component-shape objects shape)) + old (get before id) + reflected-head? (and (:component-id shape) + (:shape-ref shape) + (or (not= (boolean (:flip-x old)) (boolean (:flip-x shape))) + (not= (boolean (:flip-y old)) (boolean (:flip-y shape)))))] + (when (or reflected-head? + (and (ctk/swapped? shape) + (not (ctk/touched-group? shape :geometry-group)) + (not= (orientation old) (orientation shape)))) + (:id root))))) ids)] (reduce (fn [changes id] (let [objects (pcb/get-objects changes) @@ -1340,12 +1348,20 @@ ;; the dest root before syncing. ;; In case of subinstances, the comparison is always done with the ;; near component, because this is that we are syncing with. - origin-shape (reposition-shape origin-shape origin-root dest-root) - touched (get dest-shape :touched #{}) + origin-shape (reposition-shape origin-shape origin-root dest-root) + touched (get dest-shape :touched #{}) + ;; Direct sync of a swapped head reads its content main. Its + ;; placement comes from the replaced child in the enclosing main. + content-only? (and omit-touched? + (ctk/swapped? dest-shape) + (= (:id dest-shape) (:id dest-root))) + valid-attrs (when content-only? + (set/difference (set (keys ctk/sync-attrs)) placement-attrs)) [roperations uoperations] (attr-operations dest-shape - #(sync-attr-operations dest-shape origin-shape touched omit-touched? %))] + #(when-not (and content-only? (contains? placement-attrs %)) + (sync-attr-operations dest-shape origin-shape touched omit-touched? %)))] (cond-> changes (seq roperations) @@ -1355,7 +1371,7 @@ :always (check-swapped-main dest-shape origin-shape) :always - (generate-update-tokens container dest-shape origin-shape touched omit-touched? nil)))) + (generate-update-tokens container dest-shape origin-shape touched omit-touched? valid-attrs)))) (defn- propagate-attrs "Helper that puts the origin attributes (attrs) into dest but only if @@ -1424,6 +1440,28 @@ move? (gsh/move delta)) {:ignore-touched true})))) +(defn generate-sync-advanced-placement + "Settle the placement of swapped heads whose position reference advanced. + Read only the position frame; content may still use an older library." + [changes container libraries ids] + (reduce + (fn [changes id] + (let [objects (pcb/get-objects changes) + container (assoc container :objects objects) + shape (get objects id) + parent (get objects (:parent-id shape)) + main (ctf/find-ref-shape nil container libraries shape + :include-deleted? true :with-context? true) + main-objects (:objects (:container (meta main))) + main-parent (get main-objects (:parent-id main))] + (if (and parent main-parent) + (let [placed (get (placed-like main-objects main-parent parent) (:id main))] + (generate-take-placement changes shape placed objects + (and (ctsl/any-layout-immediate-child? objects shape) + (not (ctsl/position-absolute? shape))))) + changes))) + changes ids)) + (defn- update-swapped-placement "Synchronizes a swapped copy head with the main shape it replaces, in the attributes that place it in its parent." diff --git a/common/src/app/common/logic/shapes.cljc b/common/src/app/common/logic/shapes.cljc index c861d74797..dd2596c1b6 100644 --- a/common/src/app/common/logic/shapes.cljc +++ b/common/src/app/common/logic/shapes.cljc @@ -85,9 +85,23 @@ (reduce check-shape changes mod-obj-changes))) +(defn touch-text-typography + "Applying a typography authors every unit it sets, even equal values. + Merely editing text content keeps the ordinary changed-unit rule." + [shape] + (if (and (= :text (:type shape)) (ctk/in-component-copy? shape)) + (-> shape + (update :touched (fnil into #{}) + #{:content-group :text-content-typography :text-content-family + :text-content-weight :text-content-size :text-content-line-height + :text-content-spacing :text-content-case}) + (dissoc :remote-synced)) + shape)) + (defn generate-update-shapes [changes ids update-fn objects {:keys [attrs changed-sub-attr changed-item-index ignore-tree ignore-touched with-objects? translation? skip-grid-reassignment?]}] - (let [changes (reduce + (let [before (or objects (pcb/lookup-objects changes)) + changes (reduce (fn [changes id] ;; a shape the transform leaves untouched changes only ;; as a consequence of it: no attribute touches @@ -103,11 +117,28 @@ ;; explicitly. grid-ids (when-not (or translation? skip-grid-reassignment?) (->> ids (filter (partial ctl/grid-layout? objects)))) + hidden-grid-ids + (when-not (or translation? skip-grid-reassignment?) + (let [after (pcb/get-objects changes)] + (into (d/ordered-set) + (keep (fn [id] + (let [old (get before id) + new (get after id) + parent-id (:parent-id new)] + (when (and (not= (boolean (:hidden old)) (boolean (:hidden new))) + (ctl/grid-layout? after parent-id)) + parent-id)))) + ids))) changes (cond-> changes (seq grid-ids) (-> (pcb/update-shapes grid-ids ctl/assign-cell-positions {:with-objects? true}) (pcb/reorder-grid-children ids)) + (seq hidden-grid-ids) + (-> (pcb/update-shapes hidden-grid-ids ctl/assign-cells + {:with-objects? true :ignore-touched true}) + (pcb/reorder-grid-children hidden-grid-ids)) + (not (true? ignore-touched)) (generate-unapply-tokens objects changed-sub-attr changed-item-index))] changes)) diff --git a/common/src/app/common/logic/swap.cljc b/common/src/app/common/logic/swap.cljc index 3e7af55763..c20e45986a 100644 --- a/common/src/app/common/logic/swap.cljc +++ b/common/src/app/common/logic/swap.cljc @@ -89,7 +89,7 @@ (grc/rect->center selrect) (or (:transform shape) (gmt/matrix))))))) -(defn- switch-fixed-layout-geom-change-value +(defn- switch-size-change-value [prev-shape ; The shape before the switch current-shape ; The shape after the switch (a clean copy) origin-shape ; The original shape @@ -97,9 +97,9 @@ ;; Each dimension keeps the copy's size when both variants agree on it, ;; and takes the new variant's otherwise (selrect and points follow) (let [size (fn [dimension] - (let [prev (-> prev-shape :selrect dimension) - current (-> current-shape :selrect dimension) - origin (-> origin-shape :selrect dimension)] + (let [prev (get prev-shape dimension) + current (get current-shape dimension) + origin (get origin-shape dimension)] (if (mth/close? origin current) prev current))) width (size :width) height (size :height)] @@ -109,17 +109,6 @@ (sized-geometry-value current-shape width height attr)))) -(defn- switch-geom-change-value - [prev-shape current-shape attr] - ;; Composite geometry stores absolute coordinates. When preserving a size - ;; override across variants, keep the target variant's position and only carry - ;; the previous dimensions; otherwise :x/:y can disagree with :selrect/:points. - (sized-geometry-value current-shape - (-> prev-shape :selrect :width) - (-> prev-shape :selrect :height) - attr)) - - (defn- equal-geometry? "Returns true when the value of `attr` in `shape` is considered equal to the corresponding value in `origin-shape`, ignoring positional @@ -239,21 +228,7 @@ skip? (or skip-attr? ;; If we are going to reset the position data, skip the selrect attr - (and reset-pos-data? (= attr :selrect)) - ;; Avoid copying composite geometry attrs (:selrect/:points) when the - ;; variant dimensions differ but neither sizing is :fix. Without this, - ;; :width/:height are correctly skipped by the check above - ;; but :selrect/:points would still carry the old override dimensions, - ;; leaving the shape in an inconsistent state. When :fix sizing is - ;; present, switch-fixed-layout-geom-change-value handles the composite - ;; attrs and must NOT be bypassed. Path shapes are also handled - ;; separately via switch-path-change-value. - (and (contains? #{:selrect :points} attr) - (not path-change?) - (not (or (= :fix (:layout-item-h-sizing previous-shape)) - (= :fix (:layout-item-v-sizing previous-shape)))) - (or (not (mth/close? (:width origin-ref-shape) (:width current-shape))) - (not (mth/close? (:height origin-ref-shape) (:height current-shape)))))) + (and reset-pos-data? (= attr :selrect))) attr-val (when-not skip? @@ -278,14 +253,10 @@ origin-ref-shape attr) - (and (or (= :fix (:layout-item-h-sizing previous-shape)) - (= :fix (:layout-item-v-sizing previous-shape))) - (contains? #{:points :selrect :width :height} attr)) - (switch-fixed-layout-geom-change-value previous-shape current-shape origin-ref-shape attr) - - (and (contains? #{:points :selrect} attr) - (not path-change?)) - (switch-geom-change-value previous-shape current-shape attr) + ;; Both scalar dimensions and composite geometry must describe + ;; the same result when only one dimension carries an override. + (contains? #{:points :selrect :width :height} attr) + (switch-size-change-value previous-shape current-shape origin-ref-shape attr) :else (get previous-shape attr)))] diff --git a/common/src/app/common/test_helpers/composable/comp/files.cljc b/common/src/app/common/test_helpers/composable/comp/files.cljc index 6a898c2310..5bc81e095a 100644 --- a/common/src/app/common/test_helpers/composable/comp/files.cljc +++ b/common/src/app/common/test_helpers/composable/comp/files.cljc @@ -8,14 +8,135 @@ "File routing for the pure composable runner, including library inverses." (:require [app.common.files.changes-builder :as pcb] + [app.common.files.helpers :as cfh] [app.common.logic.libraries :as cll] [app.common.test-helpers.composable.core :as tm] - [app.common.test-helpers.files :as thf])) + [app.common.test-helpers.files :as thf] + [app.common.types.component :as ctk] + [app.common.types.container :as ctn] + [app.common.types.file :as ctf])) (defn all-files [situation] (assoc (tm/aux-files situation) (:id (tm/file situation)) (tm/file situation))) +(defn libraries + "Loaded library data, including unaccepted updates, as in the editor." + [situation] + (all-files situation)) + +(defn reference-libraries + "Oracle inputs last used by this copy. Reset/swap can refresh one subtree + while other copies still reflect an older library version. These inputs + never replace the loaded data supplied to production operations." + ([situation shape] + (reference-libraries situation (:id (tm/file situation)) (:id shape))) + ([situation file-id shape-id] + (let [files (all-files situation)] + (assoc (merge files + (get-in situation [:accepted-libraries file-id]) + (get-in situation [:shape-libraries file-id shape-id])) + file-id (get files file-id))))) + +(defn object-trees + [file] + (concat (map :objects (vals (get-in file [:data :pages-index]))) + (keep (fn [component] (when (:deleted component) (:objects component))) + (vals (get-in file [:data :components]))))) + +(defn component-shapes + [file component] + (let [objects (if (:deleted component) (:objects component) + (get-in file [:data :pages-index (:main-instance-page component) :objects]))] + (cfh/get-children-with-self objects (:main-instance-id component)))) + +(defn dependent-components + [file source-id component-ids] + (into #{} + (keep (fn [component] + (when (some #(and (:shape-ref %) (= source-id (:component-file %)) + (contains? component-ids (:component-id %))) + (component-shapes file component)) + (:id component)))) + (vals (get-in file [:data :components])))) + +(defn affected-components + "Same-file dependents, predicted from definitions before running sync." + [file component-ids] + (loop [ids (set component-ids)] + (let [next-ids (into ids (dependent-components file (:id file) ids))] + (if (= ids next-ids) ids (recur next-ids))))) + +(defn remember-subtree + [situation file-id root-id inputs] + (if-not (:accepted-libraries situation) + situation + (let [file (get (all-files situation) file-id) + objects (first (filter #(contains? % root-id) (object-trees file))) + container (ctn/make-container {:objects objects} :page) + shapes (cfh/get-children-with-self objects root-id) + source-id (:component-file (get objects root-id)) + inputs (assoc inputs file-id file) + retained (into {} + (mapcat (fn [shape] + (when (and (not= root-id (:id shape)) (ctk/swapped? shape)) + (when-let [prior (get-in situation [:shape-libraries file-id (:id shape)])] + (map #(vector (:id %) prior) + (cfh/get-children-with-self objects (:id shape))))))) + shapes)] + (reduce (fn [situation shape] + (if-not (:shape-ref shape) + situation + (let [source (when-not (ctk/swapped? shape) + (ctf/find-ref-shape file container inputs shape + :include-deleted? true :with-context? true)) + inherited (when (:shape-ref source) + (reference-libraries situation (get-in (meta source) [:file :id]) (:id source))) + ;; Retained swaps keep their content inputs. Ordinary + ;; images inherit their near copy's accepted inputs. + ;; This pull refreshes only its own source boundary. + sources (-> (merge inputs inherited (get retained (:id shape))) + (assoc source-id (get inputs source-id)) + (dissoc file-id))] + (assoc-in situation [:shape-libraries file-id (:id shape)] sources)))) + situation shapes)))) + +(defn remember-copies + [situation file-id source-id component-ids inputs] + (if-not (:accepted-libraries situation) + situation + (let [source (get inputs source-id) + source-shape-ids (into {} + (map (fn [id] + [id (into #{} (map :id) + (component-shapes source (get-in source [:data :components id])))])) + component-ids)] + (reduce (fn [situation shape] + (if (and (:shape-ref shape) (= source-id (:component-file shape)) + (contains? component-ids (:component-id shape)) + ;; Normal sync refreshes direct copies. An indirect + ;; image still follows its enclosing component's + ;; accepted definition, even if this source is newer. + (or (ctk/swapped? shape) + (contains? (get source-shape-ids (:component-id shape)) (:shape-ref shape)))) + (remember-subtree situation file-id (:id shape) inputs) + situation)) + situation (mapcat vals (object-trees (get (all-files situation) file-id))))))) + +(defn freeze-libraries + "Remember initial oracle baselines without hiding loaded library data." + [situation] + (let [files (all-files situation)] + (assoc situation :accepted-libraries + (into {} (map (fn [id] [id (dissoc files id)])) (keys files))))) + +(defn accept-library + [situation library-id] + (if (:accepted-libraries situation) + (assoc-in situation [:accepted-libraries (:id (tm/file situation)) library-id] + (get (all-files situation) library-id)) + situation)) + (defn- with-files [situation files] (let [id (:id (tm/file situation))] @@ -26,7 +147,8 @@ (defn route "Tag changes destined for another file, preserving their original order." [changes file-id] - (let [tag #(mapv (fn [change] (assoc change ::destination file-id)) %)] + (let [tag #(mapv (fn [change] + (cond-> change (nil? (::destination change)) (assoc ::destination file-id))) %)] (-> changes (update :redo-changes tag) (update :undo-changes tag)))) (defn route-update-main @@ -57,45 +179,98 @@ (partition-by #(or (::destination %) current-id) (get changes side))))))) (defn changed-components - [before changes] - (let [current-id (:id (tm/file before)) - files (all-files before)] - (into #{} - (mapcat (fn [[id group]] - (cll/changed-components (:data (get files id)) {:redo-changes group}))) - (group-by #(or (::destination %) current-id) (:redo-changes changes))))) + ([before changes] + (let [current-id (:id (tm/file before)) + files (all-files before)] + (into #{} + (mapcat (fn [[id group]] + (cll/changed-components (:data (get files id)) {:redo-changes group}))) + (group-by #(or (::destination %) current-id) (:redo-changes changes))))) + ([before after changes] + (into (changed-components before changes) + (mapcat (fn [libraries] (mapcat val libraries))) + (vals (:library-pulls after))))) (defn- sync-local [situation file-id ids] (let [files (all-files situation) - result (cll/generate-sync-components-cascade (pcb/empty-changes) file-id ids files + context (-> situation + (tm/with-file (get files file-id)) + (tm/with-aux-files (dissoc files file-id))) + result (cll/generate-sync-components-cascade (pcb/empty-changes) file-id ids (libraries context) (:id (tm/file situation))) changes (route (:changes result) file-id)] - {:situation (with-files situation (assoc-in files [file-id :data] (:data result))) + {:situation (-> (with-files situation (assoc-in files [file-id :data] (:data result))) + (remember-copies file-id file-id + (affected-components (get files file-id) ids) files)) + :component-ids (affected-components (get files file-id) ids) :syncs (if (seq (:redo-changes changes)) [changes] [])})) -(defn sync-world - "Settle changed library mains first, pull their copies into the current - file, then settle local inputs. Each cascade joins the same undo group." +(defn- pull-components + [situation consumer-id library-id component-ids] + (reduce (fn [{:keys [situation syncs]} component-id] + (let [inputs (all-files situation) + consumer (get inputs consumer-id) + result (cll/generate-sync-file-cascade + (pcb/empty-changes) nil :components consumer-id component-id library-id + inputs (:id (tm/file situation))) + changes (route (:changes result) consumer-id) + dependents (affected-components consumer + (dependent-components consumer library-id #{component-id})) + updated (-> (apply-changes situation changes) + (remember-copies consumer-id library-id #{component-id} inputs) + (remember-copies consumer-id consumer-id dependents inputs))] + {:situation updated + :syncs (cond-> syncs (seq (:redo-changes changes)) (conj changes))})) + {:situation situation :syncs []} (sort-by str component-ids))) + +(defn- sync-independent-world [situation component-ids] - (let [current-id (:id (tm/file situation)) + (let [files (all-files situation) owners (into {} (mapcat (fn [[id file]] - (map #(vector % id) (keys (get-in file [:data :components]))))) - (all-files situation)) - by-file (group-by owners component-ids) - foreign (sort-by (comp str key) (dissoc by-file current-id)) - result - (reduce (fn [{:keys [situation syncs]} [library-id ids]] - (let [settled (sync-local situation library-id ids) - situation (:situation settled) - pulled (cll/generate-sync-file-cascade - (pcb/empty-changes) nil :components current-id nil library-id - (all-files situation) current-id) - changes (:changes pulled)] - {:situation (apply-changes situation changes) - :syncs (cond-> (into syncs (:syncs settled)) - (seq (:redo-changes changes)) (conj changes))})) - {:situation situation :syncs []} foreign) - local (sync-local (:situation result) current-id (get by-file current-id []))] - {:situation (:situation local) - :syncs (into (:syncs result) (:syncs local))})) + (map #(vector % id) (keys (get-in file [:data :components]))))) files)] + (reduce + (fn [{:keys [situation syncs]} [file-id ids]] + (let [settled (sync-local situation file-id ids)] + (reduce (fn [{:keys [situation syncs]} [consumer-id requests]] + (let [requested (get requests file-id #{}) + accepted (into #{} (filter requested) (:component-ids settled)) + pulled (pull-components situation consumer-id file-id + (affected-components (get (all-files situation) file-id) + accepted))] + {:situation (update-in (:situation pulled) [:library-pulls consumer-id file-id] + #(apply disj (or % #{}) accepted)) + :syncs (into syncs (:syncs pulled))})) + {:situation (:situation settled) :syncs (into syncs (:syncs settled))} + (:library-pulls (:situation settled))))) + {:situation situation :syncs []} + (sort-by (comp str key) (group-by owners component-ids))))) + +(defn sync-world + "Settle changed mains in their source files, then local inputs. Legacy + worlds pull library changes immediately; snapshot worlds keep consumers + stale until explicit acceptance. Cascades join their user's undo group." + [situation component-ids] + (if (:accepted-libraries situation) + (sync-independent-world situation component-ids) + (let [current-id (:id (tm/file situation)) + owners (into {} (mapcat (fn [[id file]] + (map #(vector % id) (keys (get-in file [:data :components]))))) + (all-files situation)) + by-file (group-by owners component-ids) + foreign (sort-by (comp str key) (dissoc by-file current-id)) + result + (reduce (fn [{:keys [situation syncs]} [library-id ids]] + (let [settled (sync-local situation library-id ids) + situation (:situation settled) + pulled (cll/generate-sync-file-cascade + (pcb/empty-changes) nil :components current-id nil library-id + (libraries situation) current-id) + changes (:changes pulled)] + {:situation (apply-changes situation changes) + :syncs (cond-> (into syncs (:syncs settled)) + (seq (:redo-changes changes)) (conj changes))})) + {:situation situation :syncs []} foreign) + local (sync-local (:situation result) current-id (get by-file current-id []))] + {:situation (:situation local) + :syncs (into (:syncs result) (:syncs local))}))) diff --git a/common/src/app/common/test_helpers/composable/comp/nodes.cljc b/common/src/app/common/test_helpers/composable/comp/nodes.cljc index 2f6aa2a5eb..5c66625ce6 100644 --- a/common/src/app/common/test_helpers/composable/comp/nodes.cljc +++ b/common/src/app/common/test_helpers/composable/comp/nodes.cljc @@ -90,6 +90,11 @@ ;; one clause in each. ;; --------------------------------------------------------------------------- +(def scalar-properties + #{:strokes :hidden :blocked :r1 :blend-mode :hide-fill-on-export :show-content + :fixed-scroll :constraints-h :constraints-v :layout-item-margin + :layout-gap :layout-padding :layout-align-items}) + (defn set-property "`shape` with `property` set to `value`. Public so the frontend interpreter makes the same edit." @@ -101,9 +106,11 @@ :margin (assoc shape :layout-item-margin-type :simple :layout-item-margin {:m1 value :m2 value :m3 value :m4 value}) - (throw (ex-info (str "set-property: unsupported property " (pr-str property) - " (supported: :fills, :opacity, :name, :margin)") - {:property property})))) + (if (contains? scalar-properties property) + (assoc shape property value) + (throw (ex-info (str "set-property: unsupported property " (pr-str property) + " (supported: :fills, :opacity, :name, :margin)") + {:property property}))))) (defn- read-property "The comparable value of `property` in `shape`." @@ -115,9 +122,11 @@ :margin (when (= :simple (:layout-item-margin-type shape)) (let [{:keys [m1 m2 m3 m4]} (:layout-item-margin shape)] (when (= m1 m2 m3 m4) m1))) - (throw (ex-info (str "read-property: unsupported property " (pr-str property) - " (supported: :fills, :opacity, :name, :margin)") - {:property property})))) + (if (contains? scalar-properties property) + (get shape property) + (throw (ex-info (str "read-property: unsupported property " (pr-str property) + " (supported: :fills, :opacity, :name, :margin)") + {:property property}))))) (defn- applied-value* "The value a change of `property` to `value` leaves: a rename cleans the @@ -261,7 +270,9 @@ ;; derived write changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page)) #{shape-id} - #(edit-text-content % edit value) + (fn [shape] + (cond-> (edit-text-content shape edit value) + (:typography this) cls/touch-text-typography)) (:objects page) {:ignore-touched #{:name}}) file' (thf/apply-changes the-file changes)] @@ -274,8 +285,11 @@ "Constructor for the text edit operation: set the `edit` (see `text-edits`) of the text bound to `target` to `value`. On the frontend it dispatches the real `v2-update-text-shape-content`." - [target edit value] - (tm/assign-id (->EditText target edit value))) + ([target edit value] + (edit-text target edit value nil)) + ([target edit value {:keys [typography]}] + (cond-> (tm/assign-id (->EditText target edit value)) + typography (assoc :typography typography)))) ;; --------------------------------------------------------------------------- ;; Geometry operations @@ -312,7 +326,7 @@ shape (get objects shape-id) center (gsh/shape->center shape) changes (transform-changes page shape (ctm/rotation-modifiers shape center angle) - {:file the-file :libraries (cf/all-files situation)}) + {:file the-file :libraries (cf/libraries situation)}) file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') @@ -338,13 +352,43 @@ objects (:objects page) shape (get objects shape-id) changes (transform-changes page shape (ctm/change-size shape nil value) - {:file the-file :libraries (cf/all-files situation)}) + {:file the-file :libraries (cf/libraries situation)}) file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') (record-changes changes) (tm/record-application this {:target target :value value}))))) +(defn geometry-modifiers + [shape action value] + (case action + :move (ctm/move-modifiers (apply gpt/point value)) + :width (ctm/change-dimensions-modifiers shape :width value) + :height (ctm/change-dimensions-modifiers shape :height value) + :rotate (ctm/rotation-modifiers shape (gsh/shape->center shape) value) + :flip-x (ctm/resize-modifiers (gpt/point -1 1) (gsh/shape->center shape)) + :flip-y (ctm/resize-modifiers (gpt/point 1 -1) (gsh/shape->center shape)))) + +(defrecord TransformShape [target action value] + IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [this situation] + (let [file (tm/file situation) + page (thf/current-page file) + shape (get (:objects page) (tm/target-shape-id situation target)) + modifiers (geometry-modifiers shape action value) + changes (transform-changes page shape modifiers {:file file :libraries (cf/libraries situation)})] + (-> situation + (tm/with-file (thf/apply-changes file changes)) + (record-changes changes) + (tm/record-application this {:target target :action action :value value}))))) + +(defn transform-shape + [target action value] + (tm/assign-id (->TransformShape target action value))) + (defrecord MoveShape [target dx dy] IComponentOperation (op-kind [_] :frontend-only) @@ -752,10 +796,9 @@ (tm/assign-id (->InstantiateCopy name))) (defn- libraries - "The situation's files by id: the current one and the auxiliary ones." + "The current file and its loaded library versions." [situation] - (let [the-file (tm/file situation)] - (assoc (tm/aux-files situation) (:id the-file) the-file))) + (cf/libraries situation)) ;; --------------------------------------------------------------------------- ;; reset — reset the overrides of a copy head @@ -782,6 +825,7 @@ file' (thf/apply-changes the-file changes :validate? false)] (-> situation (tm/with-file file') + (cf/remember-subtree (:id the-file) shape-id (cf/all-files situation)) (record-changes changes) (tm/record-application this {:target target :reset shape-id}))))) @@ -855,8 +899,13 @@ container shape-id) (cf/route-update-main (:id the-file) (:component-file (get-in page [:objects shape-id])))) + shape (get-in page [:objects shape-id]) situation (cf/apply-changes situation changes)] (-> situation + (cond-> (and (:accepted-libraries situation) + (not= (:id the-file) (:component-file shape))) + (update-in [:library-pulls (:id the-file) (:component-file shape)] + (fnil conj #{}) (:component-id shape))) (record-changes (when (seq (:redo-changes changes)) changes)) (tm/record-application this {:target target :updated shape-id}))))) @@ -1145,6 +1194,13 @@ (keyword? to) (thi/id to) :else (lineage-component-id situation to))) +(defn swap-target-file-id + "The loaded file that owns the requested swap destination." + [situation to] + (let [component-id (swap-target-id situation to)] + (some (fn [[id file]] (when (get-in file [:data :components component-id]) id)) + (libraries situation)))) + (defrecord SwapShape [target to keep-touched?] IComponentOperation (op-kind [_] :user) @@ -1157,13 +1213,14 @@ [_ changes _] (clv/generate-component-swap-in-place (pcb/empty-changes nil (:id page)) page (libraries situation) - (:data the-file) + (:data (get (libraries situation) (swap-target-file-id situation to))) shape (swap-target-id situation to) (boolean keep-touched?)) file' (thf/apply-changes the-file changes :validate? false)] (-> situation (tm/with-file file') + (cf/remember-subtree (:id the-file) (:id shape) (cf/all-files situation)) (record-changes changes) (tm/record-application this {:target target :to to :keep-touched? keep-touched?}))))) @@ -1426,6 +1483,7 @@ file' (thf/apply-changes the-file changes :validate? false)] (-> situation (tm/with-file file') + (cf/remember-subtree (:id the-file) (:id shape) (cf/all-files situation)) (record-changes changes) (tm/record-application this {:target-component (:id component)}))))))) @@ -1728,7 +1786,7 @@ [situation] (-> situation tm/aux-files keys first)) -(defrecord SyncFromLibrary [] +(defrecord SyncFromLibrary [source] IComponentOperation (op-kind [_] :user) @@ -1736,7 +1794,7 @@ (apply-to [this situation] (let [the-file (tm/file situation) file-id (:id the-file) - lib-id (library-id situation) + lib-id (or source (library-id situation)) changes (-> (pcb/empty-changes) (cll/generate-sync-file-changes nil :components @@ -1748,14 +1806,18 @@ file' (thf/apply-changes the-file changes :validate? false)] (-> situation (tm/with-file file') + (cf/accept-library lib-id) + (cf/remember-copies file-id lib-id + (set (keys (get-in (libraries situation) [lib-id :data :components]))) + (cf/all-files situation)) (record-changes changes) (tm/record-application this {:library-id lib-id}))))) (defn sync-from-library "Constructor for the library update of the current file from the situation's library." - [] - (tm/assign-id (->SyncFromLibrary))) + ([] (sync-from-library nil)) + ([source] (tm/assign-id (->SyncFromLibrary source)))) ;; --------------------------------------------------------------------------- diff --git a/common/src/app/common/test_helpers/composable/comp/runner.cljc b/common/src/app/common/test_helpers/composable/comp/runner.cljc index ef5d67067c..aeaea06022 100644 --- a/common/src/app/common/test_helpers/composable/comp/runner.cljc +++ b/common/src/app/common/test_helpers/composable/comp/runner.cljc @@ -54,8 +54,10 @@ Throws when the file is invalid." [situation] (let [files (cf/all-files situation)] - (doseq [file (vals files)] - (thf/validate-file! file files)) + (doseq [[id file] files] + (thf/validate-file! file (cf/libraries (-> situation + (tm/with-file file) + (tm/with-aux-files (dissoc files id)))))) situation)) (defn sync-cascade @@ -79,7 +81,7 @@ (defn- sync-file [situation before changes] (let [{:keys [situation syncs]} - (cf/sync-world situation (cf/changed-components before changes))] + (cf/sync-world situation (cf/changed-components before situation changes))] [(validate-settled! situation) syncs])) (defn- push-undo-group @@ -194,6 +196,15 @@ [situation] (count (get situation ::redo-stack))) +(defn history + "The undo/redo state of one editor, without its loaded file snapshots." + [situation] + (select-keys situation [::undo-stack ::redo-stack])) + +(defn with-history + [situation history] + (merge (dissoc situation ::undo-stack ::redo-stack) history)) + (defn- snapshot [situation] (let [file (tm/file situation)] @@ -286,7 +297,7 @@ (cond-> (push-undo-group situation (into [changes] syncs)) (not sync?) (update ::pending-components (fnil into #{}) - (cf/changed-components before-situation changes))))) + (cf/changed-components before-situation situation changes))))) (and undo-check? (= kind :user)) (check-step op before depth) diff --git a/common/src/app/common/test_helpers/composable/gen.cljc b/common/src/app/common/test_helpers/composable/gen.cljc index 94e3015795..e36a922ac3 100644 --- a/common/src/app/common/test_helpers/composable/gen.cljc +++ b/common/src/app/common/test_helpers/composable/gen.cljc @@ -11,6 +11,8 @@ (:refer-clojure :exclude [flush]) (:require [app.common.files.helpers :as cfh] + [app.common.geom.modifiers :as gm] + [app.common.geom.shapes :as gsh] [app.common.logic.duplicate :as cld] [app.common.logic.shapes :as cls] [app.common.logic.variants :as clv] @@ -22,6 +24,7 @@ [app.common.test-helpers.composable.core :as tm] [app.common.test-helpers.composable.oracle :as oracle] [app.common.test-helpers.composable.shadow :as shadow] + [app.common.test-helpers.composable.variants :as variants] [app.common.test-helpers.compositions :as tho] [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] @@ -30,6 +33,7 @@ [app.common.test-helpers.texts :as thtx] [app.common.types.component :as ctk] [app.common.types.container :as ctn] + [app.common.types.modifiers :as ctm] [app.common.uuid :as uuid] [clojure.test.check.generators :as gen])) @@ -56,27 +60,59 @@ file (cond-> file (= layout :grid) (tho/place-in-grid-columns root 2 {1 child}))] (tm/with-file situation file)))) +(defn- with-outer-layout + [situation name layout] + (if-not layout + situation + (let [id ((n/main-head-of name) situation) + root (thi/label id) + child (thi/label (first (:shapes (tm/shape-by-id situation id)))) + defaults (case layout :flex cls/initial-flex-layout :grid cls/initial-grid-layout) + file (reduce-kv #(ths/update-shape %1 root %2 %3) (tm/file situation) defaults)] + (tm/with-file situation (cond-> file (= layout :grid) (tho/place-in-grid-columns root 2 {1 child})))))) + +(defn- ordered-files + [files] + (sort-by (fn [[id file]] [(:name file) (str (thi/label id))]) files)) + (defn- with-library - [situation] - (let [library (-> (tm/make-situation (thf/sample-file :random-library :is-shared true)) + [situation opts] + (let [library (-> (tm/make-situation (thf/sample-file :random-library :name "random-library" :is-shared true)) (as-> s (tm/apply-to (n/create-component "library-random" setup/labeled-fill :size 100) s)) - (as-> s (tm/apply-to (n/make-nested-component "library-random" 1) s)) + (as-> s (tm/apply-to (n/make-nested-component "library-random" (or (:library-depth opts) 1)) s)) + (as-> s (if (:library-variants opts) + (tm/apply-to (n/make-variant-container "library-variants" + [["a" setup/labeled-fill] ["b" "#ff0000"]] + :size 100) s) + s)) + (as-> s (if (and (:library-variants opts) (:rich-variants opts)) + (variants/diversify s "library-variants") s)) tm/file) - components (sort-by (comp str :id) (vals (get-in library [:data :components]))) - file (reduce (fn [file [index component copy]] + dependent (when (:library-dependency opts) + (-> (tm/make-situation (thf/sample-file :dependent-library :name "dependent-library" :is-shared true)) + (as-> s (tm/apply-to (n/create-component "library-dependent" setup/labeled-fill :size 100) s)) + tm/file + (thc/instantiate-component :sync-library-random-component :library-dependency-copy + :parent-label :sync-library-dependent-head :library library))) + libraries (cond-> {(:id library) library} dependent (assoc (:id dependent) dependent)) + components (for [[_ source] (ordered-files libraries) + entry (tree (tm/with-file situation source)) + :when (ctk/main-instance? (:shape entry))] + [source (get-in source [:data :components (get-in entry [:shape :component-id])])]) + file (reduce (fn [file [index source component copy]] (thc/instantiate-component file (thi/label (:id component)) (keyword (str "random-library-copy-" index "-" copy)) - :library library)) + :library source)) (tm/file situation) - (for [[index component] (map-indexed vector components) copy (range 2)] - [index component copy]))] - (-> situation (tm/with-file file) (tm/with-aux-files {(:id library) library})))) + (for [[index [source component]] (map-indexed vector components) copy (range 2)] + [index source component copy]))] + (-> situation (tm/with-file file) (tm/with-aux-files libraries)))) (defn forest "All live page trees, with stable file/page prefixes for model replay." [situation] - (vec (for [[file-index [_ file]] (map-indexed vector (sort-by (comp str key) (cf/all-files situation))) + (vec (for [[file-index [_ file]] (map-indexed vector (ordered-files (cf/all-files situation))) [page-index page-id] (map-indexed vector (get-in file [:data :pages])) entry (tree (tm/with-file situation (with-meta file {:current-page-id page-id})))] (update entry :path #(into [:file file-index :page page-index] %))))) @@ -95,36 +131,50 @@ (-> (tm/apply-to (n/create-component name setup/labeled-fill :size 100) s) (with-layout name (when (zero? index) (:layout opts))) (as-> s (reduce #(tm/apply-to %2 %1) s - [(n/make-nested-component name depth) - (n/instantiate-copy name) - (n/instantiate-copy name)]))))) + [(n/make-nested-component name depth)])) + (with-outer-layout name (when (and (zero? index) (:layout-copies opts)) (:layout opts))) + (as-> s (reduce #(tm/apply-to %2 %1) s [(n/instantiate-copy name) (n/instantiate-copy name)]))))) (let [s (setup/empty-situation) s (if (:variants opts) - (reduce #(tm/apply-to %2 %1) s - [(n/create-component "variant" setup/labeled-fill :size 100) - (n/make-variant-container "random-variants" - [["a" setup/labeled-fill] - ["b" (if (:variant-diff opts) "#ff0000" setup/labeled-fill)]] - :size 100) - (n/make-nested-component-with-variant "variant" "random-variants" "a") - (n/make-nested-component "variant" 1) - (n/instantiate-copy "variant") - (n/instantiate-copy "variant")]) + (let [s (reduce #(tm/apply-to %2 %1) s + [(n/create-component "variant" setup/labeled-fill :size 100) + (n/make-variant-container "random-variants" + (variants/members setup/labeled-fill (:rich-variants opts) + (:variant-diff opts)) + :size 100)]) + s (cond-> s (:rich-variants opts) (variants/diversify "random-variants"))] + (reduce #(tm/apply-to %2 %1) s + [(n/make-nested-component-with-variant "variant" "random-variants" "a") + (n/make-nested-component "variant" 1) + (n/instantiate-copy "variant") + (n/instantiate-copy "variant")])) s)] (cond-> s (:text opts) (tm/with-file (-> (thtx/add-text-component-with-copy (tm/file s) [[["Hello world"]]]) + (cond-> (:text-styles opts) + (ths/add-sample-typography :generated-typography + :font-id "gfont-roboto" :font-family "Roboto" + :font-variant-id "700italic" :font-weight "700" + :font-style "italic" :font-size "22" + :line-height "1.6" :letter-spacing "2" + :text-transform "uppercase")) (ths/update-shape :main-child :grow-type :auto-height) (ths/update-shape :copy-child :grow-type :auto-height) (ths/update-shape :copy-child :touched nil))))) (range components)) - (:library opts) (with-library))) + (:library opts) (with-library opts) + (:stale-libraries opts) (cf/freeze-libraries) + (:rich-variants opts) (as-> s (assoc s :shape-budget (+ 80 (count (tree s))))))) (defn candidates [situation model kind scope] (let [objects (:objects (thf/current-page (tm/file situation))) file (tm/file situation) - libraries (assoc (tm/aux-files situation) (:id file) file) + libraries (cf/libraries situation) + nearest (memoize (fn [file-id component-id pos value] + (variants/nearest (get libraries file-id) + {:component-id component-id} pos value))) copy-head (fn [shape] (and (:shape-ref shape) (:component-id shape))) live-component (fn [shape] (let [component (get-in libraries [(:component-file shape) :data :components (:component-id shape)])] @@ -138,6 +188,7 @@ (case kind :edit (and (not= :text (:type shape)) (case scope + :copy-head (and (copy-head shape) (live-component shape)) 1 (:shape-ref shape) 2 (and (:shape-ref shape) (some #(contains? (tm/aux-files situation) (:component-file %)) @@ -147,11 +198,20 @@ :update-main (and (top-copy shape) (live-component shape) (overridden (:id shape))) :detach (top-copy shape) (:resize :rotate) (top-copy shape) - :text (= :text (:type shape)) + :transform (and (not= :text (:type shape)) + (case (mod (or scope 0) 5) + 0 (ctk/main-instance? shape) + 1 (and (nil? (:shape-ref shape)) + (not (ctk/main-instance? shape)) + (some ctk/main-instance? (cfh/get-parents objects (:id shape)))) + 2 (and (:shape-ref shape) (nil? (:component-id shape))) + 3 (and (copy-head shape) (not (top-copy shape))) + 4 (top-copy shape))) + (:text :text-style) (= :text (:type shape)) :add-child (ctk/main-instance? shape) :remove-child (and (= :rect (:type shape)) (nil? (:shape-ref shape)) (some ctk/main-instance? (cfh/get-parents-with-self objects (:id shape)))) - :duplicate (and (top-copy shape) (< (count objects) 120) + :duplicate (and (top-copy shape) (< (count objects) (get situation :shape-budget 120)) (cld/allow-duplicate? objects shape)) :nest (and (top-copy shape) (not (overridden (:id shape)))) :delete (ctk/main-instance? shape) @@ -161,19 +221,34 @@ (case kind (:swap :switch) (vec (for [entry eligible - destination (tree situation) + destination (if (:accepted-libraries situation) + (mapcat (fn [[index [id library]]] + (map #(cond-> % + (not= id (:id file)) + (update :path (fn [path] (into [:library index] path)))) + (tree (tm/with-file situation library)))) + (map-indexed vector (ordered-files libraries))) + (tree situation)) :let [shape (:shape entry) main (:shape destination) - origin (get-in file [:data :components (:component-id shape)]) - component (get-in file [:data :components (:component-id main)])] + origin (get-in libraries [(:component-file shape) :data :components (:component-id shape)]) + component (get-in libraries [(:component-file main) :data :components (:component-id main)])] + pos (if (= kind :switch) (range (count (:variant-properties origin))) [nil]) + :let [value (get-in component [:variant-properties pos :value]) + expected (when (= kind :switch) + (nearest (:component-file shape) (:component-id shape) pos value))] :when (and (ctk/main-instance? main) (not= (:component-id shape) (:component-id main)) (or (= kind :swap) (and (:variant-id origin) - (= (:variant-id origin) (:variant-id component)))) - (not (clv/swap-nesting-loop? objects shape (:data file) (:id component))))] + (= (:component-file shape) (:component-file main)) + (= (:variant-id origin) (:variant-id component)) + (= (:id component) (:id expected)))) + (not (clv/swap-nesting-loop? objects shape + (:data (get libraries (:component-file main))) + (:id component))))] (assoc entry :destination destination - :variant-value (get-in component [:variant-properties 0 :value])))) + :variant-value value :variant-pos pos))) :restore (->> (vals (get-in file [:data :components])) (filter :deleted) (sort-by (comp str :id)) @@ -192,11 +267,108 @@ (assoc entry :into (:path parent) :parent (:shape parent)))) eligible))) +(def library-source-kinds + #{:library-edit :library-add-child :library-remove-child :library-delete :library-restore + :library-undo :library-redo :library-accept}) + +(defn- library-candidates + [situation kind] + (vec + (for [[library-index [library-id library]] + (map-indexed vector (ordered-files (tm/aux-files situation))) + entry (cond + (= kind :library-accept) + (for [[source-id _] (ordered-files (tm/aux-files situation)) + :when (and (not= source-id library-id) + (some #(= source-id (:component-file %)) + (mapcat vals (cf/object-trees library))))] + {:path [:accept (:name (get (tm/aux-files situation) source-id))] + :source-id source-id}) + (#{:library-undo :library-redo} kind) + (let [history (get-in situation [:library-histories library-id :runner]) + editor (r/with-history situation history)] + (when (pos? ((if (= kind :library-undo) r/undo-depth r/redo-depth) editor)) + [{:path []}])) + (= kind :library-restore) + (map-indexed (fn [index component] + {:path [:deleted index] + :shape {:id (:main-instance-id component) :component-id (:id component)}}) + (sort-by (comp str :id) (filter :deleted (vals (get-in library [:data :components]))))) + :else + (filter (fn [{:keys [shape]}] + (case kind + (:library-edit :library-remove-child) + (and (= :rect (:type shape)) (nil? (:shape-ref shape))) + (:library-add-child :library-delete) (ctk/main-instance? shape))) + (tree (tm/with-file situation library))))] + (-> entry + (assoc :library-id library-id) + (update :path #(into [:library library-index] %)))))) + +(def style-edits + "Scalar edit inputs. Geometry, text units and grid cell identity use + dedicated operations; this table does not read production sync groups." + [[:strokes [[] [{:stroke-color "#ff0000" :stroke-opacity 1 :stroke-width 2 + :stroke-style :solid :stroke-alignment :center}]]] + [:hidden [false true]] + [:blocked [false true]] + [:r1 [0 8 16]] + [:blend-mode [:normal :multiply :screen]] + [:hide-fill-on-export [false true]] + [:show-content [false true]] + [:fixed-scroll [false true]] + [:constraints-h [:left :scale :leftright :center :right]] + [:constraints-v [:top :scale :topbottom :center :bottom]] + [:layout-item-margin [{:m1 0 :m2 0 :m3 0 :m4 0} {:m1 4 :m2 4 :m3 4 :m4 4}]] + [:layout-gap [{:row-gap 0 :column-gap 0} {:row-gap 8 :column-gap 8}]] + [:layout-padding [{:p1 0 :p2 0 :p3 0 :p4 0} {:p1 8 :p2 8 :p3 8 :p4 8}]] + [:layout-align-items [:start :center :end]]]) + +(def text-style-edits + "All twelve style units, independent of the production text group table." + [[:family ["sourcesanspro" "Roboto"]] + [:weight [400 700]] + [:size [14 18]] + [:line-height [1.2 1.5]] + [:spacing [0 2]] + [:decoration ["none" "underline"]] + [:case ["none" "uppercase"]] + [:color [:black :red]] + [:typography [nil :generated-typography]] + [:align ["left" "center"]] + [:direction ["ltr" "rtl"]] + [:valign ["top" "bottom"]]]) + +(defn- edit-text-style + [shape unit value] + (let [[style values] (nth text-style-edits (mod (or unit 0) (count text-style-edits))) + value (nth values (mod (or value 0) (count values))) + text (thtx/view (:content shape))] + (case style + (:align :direction :line-height) (thtx/restyle-paragraphs text style value) + :valign (thtx/set-valign text value) + :typography (if value + (thtx/apply-typography text value + {:family "Roboto" :weight 700 :italic true :size 22 + :line-height 1.6 :spacing 2 :case "uppercase"}) + (thtx/restyle text style nil)) + (thtx/restyle text style value)))) + (defn resolve-op "Resolve one tuple. Empty target sets produce an explicit skip." [situation model [kind index property value scope :as tuple]] (let [index (or index 0) - items (cond->> (candidates situation model kind scope) + [style-property style-values] (nth style-edits (mod (or property 0) (count style-edits))) + items (cond->> (if (contains? library-source-kinds kind) + (library-candidates situation kind) + (candidates situation model (if (= kind :style) :edit kind) scope)) + (= kind :style) + (filter (fn [{:keys [shape]}] + (and (shadow/attribute-applicable? shape style-property) + (case style-property + (:layout-gap :layout-padding :layout-align-items) (some? (:layout shape)) + :layout-item-margin (some? (:layout (tm/shape-by-id situation (:parent-id shape)))) + true)))) (and (= kind :edit) (= 2 (mod (or property 0) 3))) (remove (fn [{:keys [shape]}] ;; Variant names encode properties or rename the set. @@ -207,19 +379,41 @@ [:data :components (:component-id shape) :variant-id]))))) selected (when (seq items) (nth items (mod index (count items)))) target (when selected (constantly (get-in selected [:shape :id]))) - property (nth [:fills :opacity :name] (mod (or property 0) 3)) - value (case property - :fills (nth [setup/labeled-fill "#ff0000" "#00ff00"] (mod (or value 0) 3)) - :opacity (nth [1 0.4 0.7] (mod (or value 0) 3)) - :name (str "Label " (mod (or value 0) 3))) + property (if (= kind :style) style-property + (nth [:fills :opacity :name] (mod (or property 0) 3))) + value (if (= kind :style) (nth style-values (mod (or value 0) (count style-values))) + (case property + :fills (nth [setup/labeled-fill "#ff0000" "#00ff00"] (mod (or value 0) 3)) + :opacity (nth [1 0.4 0.7] (mod (or value 0) 3)) + :name (str "Label " (mod (or value 0) 3)))) op (case kind :sync nil - :library-sync (when (seq (tm/aux-files situation)) (n/sync-from-library)) + :library-sync (when (seq (tm/aux-files situation)) + (n/sync-from-library (key (nth (vec (ordered-files (tm/aux-files situation))) + (mod index (count (tm/aux-files situation))))))) :undo (when (pos? (r/undo-depth situation)) (n/undo)) :redo (when (pos? (r/redo-depth situation)) (n/redo)) + :library-accept (when selected (n/sync-from-library (:source-id selected))) + :library-undo (when selected (n/undo)) + :library-redo (when selected (n/redo)) (when target (case kind - :edit (n/change-property target property value) + (:edit :style) (n/change-property target property value) + :transform (let [action (nth [:move :width :height :rotate :flip-x :flip-y] + (mod (or (nth tuple 2 nil) 0) 6)) + value (or (nth tuple 3 nil) 0)] + (n/transform-shape target action + (case action + :move [(* 5 (inc (mod value 4))) (* -3 (inc (mod value 3)))] + (:width :height) (+ 80 (* 20 (mod value 6))) + :rotate (* 45 (inc (mod value 4))) + nil))) + :library-edit (n/change-property target property value) + :library-add-child (n/add-child target (keyword (str "library-generated-" (count (:applied situation)))) + :width 20 :height 20 :x 10 :y 10) + :library-remove-child (n/remove-child target) + :library-delete (n/delete-component target) + :library-restore (n/restore-component (n/delete-component target)) :reset (n/reset target) :update-main (n/update-main target) :detach (n/detach target) @@ -230,6 +424,12 @@ (thtx/set-letters text (nth ["Hello world" "Hello there" "Hello\nworld"] (mod (or (nth tuple 3 nil) 0) 3))) (thtx/restyle text :size (nth [14 18 24] (mod (or (nth tuple 3 nil) 0) 3))))] (n/edit-text target :content text)) + :text-style (n/edit-text target :content + (edit-text-style (:shape selected) (nth tuple 2 nil) (nth tuple 3 nil)) + (when (and (= 8 (mod (or (nth tuple 2 nil) 0) (count text-style-edits))) + (odd? (or (nth tuple 3 nil) 0))) + {:typography {:id (thi/id :generated-typography) + :file-id (:id (tm/file situation))}})) :add-child (n/add-child target (keyword (str "generated-" (count (:applied situation)))) :width 20 :height 20 :x 10 :y 10) :remove-child (n/remove-child target) @@ -237,75 +437,199 @@ :nest (n/nest-copy target (constantly (get-in selected [:parent :id]))) :delete (n/delete-component target) :swap (n/swap-shape target (constantly (get-in selected [:destination :shape :component-id]))) - :switch (n/switch-variant target (:variant-value selected)) + :switch (n/switch-variant target (:variant-value selected) :pos (:variant-pos selected)) :restore (n/restore-component (n/delete-component target)))))] - {:op op :shape (:shape selected) :property property :value value + {:op op :library-id (:library-id selected) :shape (:shape selected) + :destination (:shape (:destination selected)) :property property :value value + :opportunities (if (seq items) (count items) (if (or op (= kind :sync)) 1 0)) :trace (cond-> {:kind kind :tuple tuple :status (if (or op (= kind :sync)) :executed :skip)} selected (assoc :target (:path selected)) (:into selected) (assoc :into (:into selected)) (:destination selected) (assoc :to (get-in selected [:destination :path])) + (= kind :switch) (assoc :property-pos (:variant-pos selected)) (and (nil? op) (not= kind :sync)) (assoc :reason (str "No eligible " (name kind) " target")))})) -(defn- assert-round-trip +(defn- reference-snapshot + [situation] + (when (:accepted-libraries situation) + (into {} (for [[file-id file] (cf/all-files situation) + objects (cf/object-trees file) + [id shape] objects + :when (:shape-ref shape)] + [[file-id id] {:shape shape + :sources (dissoc (cf/reference-libraries situation file-id id) file-id)}])))) + +(defn- reference-patches [before after] - (let [undone (r/step after (n/undo)) - redone (r/step undone (n/redo))] + (reduce (fn [patches key] + (if (= (get-in before [key :shape]) (get-in after [key :shape])) + patches + (-> patches + (assoc-in [:reference-before key] (get-in before [key :sources])) + (assoc-in [:reference-after key] (get-in after [key :sources]))))) + {} (into (set (keys before)) (keys after)))) + +(defn- restore-references + [situation patch] + (reduce-kv (fn [situation [file-id id] sources] + (if sources + (assoc-in situation [:shape-libraries file-id id] sources) + (update-in situation [:shape-libraries file-id] dissoc id))) + situation (or patch {}))) + +(defn- assert-round-trip + [before after journal] + (let [undone (r/step (restore-references after (:reference-before journal)) (n/undo)) + redone (r/step (restore-references undone (:reference-after journal)) (n/redo))] (when-not (= before (oracle/snapshot undone)) (oracle/fail :I7 {:phase :undo :diff (thn/diff before (oracle/snapshot undone))})) (when-not (= (oracle/snapshot after) (oracle/snapshot redone)) (oracle/fail :I7 {:phase :redo})))) +(defn- synchronizable-components + "Full-sync equivalence applies to components whose external inputs have + been accepted. Pulling an unaccepted source is a user action, not I5/I6." + [situation] + (let [files (cf/all-files situation) + fingerprint (memoize + (fn [file component-id] + (when-let [component (get-in file [:data :components component-id])] + [(dissoc component :modified-at :objects) + (mapv #(if (= (:id %) (:main-instance-id component)) + (dissoc % :x :y :points :selrect) %) + (cf/component-shapes file component))])))] + (for [[file-id file] files + [component-id component] (get-in file [:data :components]) + :when (or (nil? (:accepted-libraries situation)) + (every? (fn [shape] + (let [source-id (:component-file shape) + source-component (:component-id shape)] + (or (nil? (:shape-ref shape)) (nil? source-component) (= source-id file-id) + (= (fingerprint (get (cf/reference-libraries situation file-id (:id shape)) source-id) + source-component) + (fingerprint (get files source-id) source-component))))) + (cf/component-shapes file component)))] + component-id))) + (defn settle-state [{:keys [situation model checkpoint] :as state}] (let [settled (r/settle situation) model (-> model (shadow/parent-orientation (all-objects situation) (all-objects settled)) (shadow/settle (all-objects settled))) - all (mapcat #(keys (get-in % [:data :components])) (vals (cf/all-files situation))) + all (into (set (synchronizable-components situation)) (r/pending-components situation)) full-before (:situation (cf/sync-world situation all)) full (:situation (cf/sync-world settled all)) - settled-design (oracle/canonical settled) - full-before-design (oracle/canonical full-before) - full-design (oracle/canonical full)] + opts {:free-head-placement false} + settled-design (oracle/canonical settled opts) + full-before-design (oracle/canonical full-before opts) + full-design (oracle/canonical full opts) + journal (when checkpoint + (merge (peek (:undo state)) + (reference-patches (:reference-start (peek (:undo state))) + (reference-snapshot settled)) + {:after model}))] (oracle/check settled model) (when-not (oracle/equivalent? settled-design full-before-design) (oracle/fail :I6 {:diff (thn/diff settled-design full-before-design)})) (when-not (oracle/equivalent? settled-design full-design) - (oracle/fail :I5 {})) - (when checkpoint (assert-round-trip checkpoint settled)) + (oracle/fail :I5 {:diff (thn/diff settled-design full-design)})) + (when checkpoint (assert-round-trip checkpoint settled journal)) (cond-> (assoc state :situation settled :model model :checkpoint nil) - (and (not= model (:model state)) (seq (:undo state))) - (assoc-in [:undo (dec (count (:undo state))) :after] model)))) + journal (assoc-in [:undo (dec (count (:undo state)))] (dissoc journal :reference-start))))) + +(defn- source-context + [situation owner] + (let [files (cf/all-files situation)] + (-> (tm/make-situation (get files owner)) + (tm/with-aux-files (dissoc files owner)) + (merge (select-keys situation [:accepted-libraries :shape-libraries])) + (r/with-history (get-in situation [:library-histories owner :runner]))))) + +(defn- apply-source + "A remote editor owns its own undo history. Its notification changes only + the loaded source file; consumer copies wait for their own user action." + [situation owner op kind] + (let [before (source-context situation owner) + history (get-in situation [:library-histories owner] + {:undo [] :redo [] :baseline (get (oracle/snapshot before) owner)}) + undo? (= kind :library-undo) + redo? (= kind :library-redo) + journal (cond undo? (peek (:undo history)) redo? (peek (:redo history))) + after (-> (cond-> before + undo? (restore-references (:reference-before journal)) + redo? (restore-references (:reference-after journal))) + (r/step op) r/settle) + changed (> (r/undo-depth after) (r/undo-depth before)) + entry (when (and changed (not undo?) (not redo?)) + (reference-patches (reference-snapshot before) (reference-snapshot after))) + history (cond + undo? (-> history (update :undo pop) (update :redo conj journal)) + redo? (-> history (update :redo pop) (update :undo conj journal)) + entry (-> history (update :undo conj entry) (assoc :redo [])) + :else history) + files (cf/all-files after) + current-id (:id (tm/file situation))] + (when entry (assert-round-trip (oracle/snapshot before) after entry)) + (when-not (= (dissoc (oracle/snapshot before) owner) (dissoc (oracle/snapshot after) owner)) + (oracle/fail :I7 {:phase :source-editor-wrote-another-file})) + (-> situation + (tm/with-file (get files current-id)) + (tm/with-aux-files (dissoc files current-id)) + (merge (select-keys after [:accepted-libraries :shape-libraries])) + (assoc-in [:library-histories owner] (assoc history :runner (r/history after))) + (tm/record-application op {:library-id owner})))) + +(defn requested-geometry + "Predict a transform's result from this backend's before-state and intent." + [situation {:keys [shape op]} kind] + (let [objects (:objects (thf/current-page (tm/file situation))) + modifiers (case kind + :resize (ctm/change-size shape nil (:value op)) + :rotate (n/geometry-modifiers shape :rotate (:angle op)) + :transform (n/geometry-modifiers shape (:action op) (:value op))) + tree (gm/set-objects-modifiers {(:id shape) {:modifiers modifiers}} objects)] + (gsh/transform-shape shape (get-in tree [(:id shape) :modifiers])))) (defn- update-model [model before after {:keys [shape property value op]} kind] (let [objects (all-objects before) id (:id shape)] (case kind - :edit (shadow/edit model shape property value) + (:edit :style) (shadow/edit model shape property value) :reset (shadow/clear-subtree model objects id) :update-main (shadow/update-main model objects (all-objects after) id) :detach (shadow/detach model objects (all-objects after) id) - :text (shadow/edit-text model shape (:content (n/text-edit-commit shape (:edit op) (:value op)))) + :nest (let [parent (get objects (tm/target-shape-id before (:into op)))] + (if (:blocked parent) + (shadow/edit model shape :blocked true) + model)) + (:text :text-style) (shadow/edit-text model shape (:content (n/text-edit-commit shape (:edit op) (:value op))) + (some? (:typography op))) :duplicate (shadow/duplicate model objects id (:objects (thf/current-page (tm/file after))) (:new-head (n/applied-result op (tm/file before) (tm/file after)))) (:swap :switch) (let [after-objects (all-objects after) - old-main (get-in (cf/all-files before) [(:component-file shape) :data :components + old-main (get-in (cf/libraries before) [(:component-file shape) :data :components (:component-id shape) :main-instance-id]) head (get after-objects id) - new-main (get-in (cf/all-files after) [(:component-file head) :data :components + new-main (get-in (cf/libraries after) [(:component-file head) :data :components (:component-id head) :main-instance-id])] (shadow/swap model objects after-objects id old-main new-main (= kind :switch))) - (:resize :rotate) - (let [shape-after (tm/shape-by-id after id) - group :geometry-group] - (if (= (shadow/values shape group) (shadow/values shape-after group)) - model - (assoc-in model [id group] (shadow/values shape-after group)))) + (:resize :rotate :transform) + (let [shape-after (requested-geometry before {:shape shape :op op} kind) + group :geometry-group + parent (get objects (:parent-id shape)) + position? (and (:shape-ref parent) + (not (contains? (oracle/derived-attributes objects shape) :x))) + changed? (or (not (shadow/same-value? shape-after group (shadow/values shape group))) + (and position? (not (gsh/close-attrs? :points (:points shape) (:points shape-after) 1e-10))))] + (if (and (:shape-ref shape) changed?) + (assoc-in model [id group] (shadow/author-geometry shape-after (when position? parent))) + model)) model))) (defn step @@ -313,17 +637,37 @@ (let [[kind index] tuple state (if (= kind :sync) state (settle-state state)) {:keys [situation model]} state - {:keys [op trace] :as resolved} (resolve-op situation model tuple) - state (update state :trace conj trace)] + {:keys [op trace opportunities library-id] :as resolved} (resolve-op situation model tuple) + phase (or (:phase state) :random) + coverage-path [:coverage phase kind] + state (-> state + (update :trace conj trace) + (update-in (conj coverage-path :attempted) (fnil inc 0)) + (update-in (conj coverage-path :eligible) (fnil + 0) (if (pos? opportunities) 1 0)) + (update-in (conj coverage-path :opportunities) (fnil + 0) opportunities))] (if (= :skip (:status trace)) - state - (let [after (if (= kind :sync) + (update-in state (conj coverage-path :skipped) (fnil inc 0)) + (let [operation-situation + (case kind + :undo (restore-references situation (:reference-before (peek (:undo state)))) + :redo (restore-references situation (:reference-after (peek (:redo state)))) + situation) + after (cond + library-id (apply-source situation library-id op kind) + (= kind :sync) (let [pending (sort-by #(str (thi/label %)) (r/pending-components situation)) selected (if (and (odd? (or index 0)) (seq pending)) [(nth (vec pending) (mod index (count pending)))] pending)] (r/settle situation selected)) - (r/step situation op)) + :else (r/step operation-situation op)) + after (if library-id after + (reduce (fn [after owner] + (cond-> after + (not= (get (oracle/snapshot situation) owner) + (get (oracle/snapshot after) owner)) + (assoc-in [:library-histories owner :foreign-write] true))) + after (keys (:library-histories situation)))) changed (not= (r/undo-depth situation) (r/undo-depth after)) history (:undo state) redo (:redo state) @@ -335,9 +679,35 @@ (not (#{:undo :redo} kind)) (shadow/parent-orientation (all-objects situation) (all-objects after))) next-model (shadow/settle next-model (all-objects after)) + meaningful (not (oracle/equivalent? (oracle/design-snapshot situation {:free-head-placement false}) + (oracle/design-snapshot after {:free-head-placement false}))) state (-> state (assoc :situation after :model next-model) + (update-in (conj coverage-path (if meaningful :changed :no-op)) (fnil inc 0)) + (cond-> (and (not meaningful) + (> (r/undo-depth after) (r/undo-depth situation))) + (update-in (conj coverage-path :undo-only) (fnil inc 0))) (update-in [:executed kind] (fnil inc 0)))] + (when (#{:resize :rotate :transform} kind) + (oracle/check-requested-geometry (:objects (thf/current-page (tm/file after))) + (tm/shape-by-id after (get-in resolved [:shape :id])) + (requested-geometry situation resolved kind))) + (when (#{:swap :switch} kind) + (let [head (tm/shape-by-id after (get-in resolved [:shape :id]))] + (when-not (= (get-in resolved [:destination :component-id]) (:component-id head)) + (oracle/fail :I9 {:phase :requested-component :kind kind})))) + (when (#{:text :text-style} kind) + (let [actual (tm/shape-by-id after (get-in resolved [:shape :id])) + expected (thtx/normalize (:value op))] + (when-not (= expected (thtx/view (:content actual))) + (oracle/fail :I9 {:phase :requested-text :expected expected + :actual (thtx/view (:content actual))})))) + (when (#{:edit :style :library-edit} kind) + (let [file (if library-id (get (cf/all-files after) library-id) (tm/file after)) + actual (tm/shape-by-id (tm/with-file after file) (get-in resolved [:shape :id])) + expected (n/set-property (:shape resolved) (:property resolved) (:value resolved))] + (when-not (= (get expected (:property resolved)) (get actual (:property resolved))) + (oracle/fail :I9 {:phase :requested-scalar :property (:property resolved)})))) (oracle/check after next-model (empty? (r/pending-components after))) (case kind :sync (cond-> state @@ -346,36 +716,65 @@ :redo (-> state (assoc :redo (pop redo)) (update :undo conj (peek redo))) (cond-> state changed (-> (assoc :checkpoint (oracle/snapshot situation) :redo []) - (update :undo conj {:before model :after next-model})))))))) + (update :undo conj {:before model :after next-model + :reference-start (reference-snapshot situation)})))))))) (defn initial-state [world-spec] (let [situation (world world-spec)] {:situation situation :baseline (oracle/snapshot situation) - :model {} :trace [] :undo [] :redo [] :executed {}})) + :model {} :trace [] :undo [] :redo [] :executed {} :coverage {}})) (defn- check-sequence - [{:keys [situation baseline]}] + [{:keys [situation baseline undo]}] (let [depth (r/undo-depth situation) - undone (r/step situation (n/undo depth)) - redone (nth (iterate #(r/step % (n/redo)) undone) depth)] - (when-not (= baseline (oracle/snapshot undone)) + undone (reduce (fn [situation entry] + (r/step (restore-references situation (:reference-before entry)) (n/undo))) + situation (rseq undo)) + redone (reduce (fn [situation entry] + (r/step (restore-references situation (:reference-after entry)) (n/redo))) + undone undo)] + (when-not (= depth (count undo)) + (oracle/fail :I7 {:phase :history-depth :runner depth :model (count undo)})) + (when-not (if (:accepted-libraries situation) + (= (get baseline (:id (tm/file situation))) + (get (oracle/snapshot undone) (:id (tm/file situation)))) + (= baseline (oracle/snapshot undone))) (oracle/fail :I7 {:phase :sequence-undo})) (when-not (= (oracle/snapshot situation) (oracle/snapshot redone)) (oracle/fail :I7 {:phase :sequence-redo})))) +(defn- check-source-sequences + [situation] + (doseq [[owner {:keys [undo baseline foreign-write]}] (:library-histories situation)] + (let [editor (source-context situation owner) + undone (reduce (fn [editor entry] + (r/step (restore-references editor (:reference-before entry)) (n/undo))) + editor (rseq undo)) + redone (reduce (fn [editor entry] + (r/step (restore-references editor (:reference-after entry)) (n/redo))) + undone undo)] + (when-not (= (count undo) (r/undo-depth editor)) + (oracle/fail :I7 {:phase :source-history-depth})) + (when (and (not foreign-write) (not= baseline (get (oracle/snapshot undone) owner))) + (oracle/fail :I7 {:phase :source-sequence-undo})) + (when-not (= (oracle/snapshot editor) (oracle/snapshot redone)) + (oracle/fail :I7 {:phase :source-sequence-redo}))))) + (defn run "Run a program. A supplied trace must replay the same targets and skips. Failures include the program and labelled trace for a regression." ([program] (run program nil)) - ([{:keys [ops] world-spec :world :as program} replay-trace] + ([{:keys [prefix ops] world-spec :world :as program} replay-trace] (let [progress (atom (initial-state world-spec))] (try - (doseq [tuple ops] - (swap! progress assoc :current tuple) + (doseq [[phase tuple] (concat (map #(vector :setup %) prefix) + (map #(vector :random %) ops))] + (swap! progress assoc :current tuple :phase phase) (swap! progress step tuple)) (swap! progress settle-state) (check-sequence @progress) + (check-source-sequences (:situation @progress)) (when-not (pos? (reduce + 0 (vals (dissoc (:executed @progress) :sync)))) (throw (ex-info "No operations executed" {:type ::empty-program}))) (when (and replay-trace (not= replay-trace (:trace @progress))) @@ -385,6 +784,7 @@ (throw (ex-info (str (ex-message cause) "\nReplay: (cg/run " (pr-str program) ")" "\nTrace: " (pr-str (:trace @progress))) (assoc (ex-data cause) :program program :trace (:trace @progress) + :coverage (:coverage @progress) :failing-op (:current @progress)) cause))))))) @@ -394,18 +794,87 @@ [program coverage failure] (try (let [result (run program)] - (swap! coverage #(merge-with + % (:executed result))) + (swap! coverage #(merge-with (partial merge-with (partial merge-with +)) % (:coverage result))) true) (catch #?(:clj Throwable :cljs :default) error (let [data (ex-data error) signature [(:invariant data) (:type data) (:phase data) (first (:failing-op data))]] (cond - (= ::empty-program (:type data)) true + (= ::empty-program (:type data)) + (do + (swap! coverage #(merge-with (partial merge-with (partial merge-with +)) % (:coverage data))) + true) (or (= signature @failure) (compare-and-set! failure nil signature)) (throw error) :else true))))) +(defn coverage-errors + "Coverage comes only from random steps. Stable syncs count as checks; + mutations must change state and each required kind must supply at least + 0.5% of meaningful changes. Setup, skips and no-ops cannot satisfy it." + ([coverage kinds] (coverage-errors coverage kinds #{:sync :library-sync})) + ([coverage kinds checks] + (let [random (:random coverage) + mutations (remove checks kinds) + total-changed (reduce + 0 (map #(get-in random [% :changed] 0) mutations)) + attempted (reduce + 0 (map #(get-in random [% :attempted] 0) mutations))] + (cond-> (into [] + (keep (fn [kind] + (let [{:keys [changed no-op] :or {changed 0 no-op 0}} (get random kind)] + (when (if (contains? checks kind) + (zero? (+ changed no-op)) + (or (zero? changed) + (< changed (* 0.005 total-changed)))) + {:kind kind :reason :insufficient-random-coverage + :counts (get random kind)})))) + kinds) + (or (zero? total-changed) (< total-changed (* 0.1 attempted))) + (conj {:reason :insufficient-random-mutations :changed total-changed :attempted attempted}))))) + +(defn operation-gen + "Random single actions and short user histories. Every chunk can shrink + away; none is a required prefix. Pairs expose operations whose targets + otherwise rarely exist, while standalone actions still exercise skips." + [kinds] + (let [tuple (gen/tuple (gen/elements kinds) gen/nat gen/nat gen/nat gen/nat) + histories (cond-> [[24 (gen/fmap vector tuple)]] + (contains? (set kinds) :style) + (conj [2 (gen/fmap (fn [[index property]] [[:style index property 1]]) + (gen/tuple gen/nat (gen/choose 0 (dec (count style-edits)))))]) + (contains? (set kinds) :text-style) + (conj [2 (gen/fmap (fn [[index unit]] [[:text-style index unit 1]]) + (gen/tuple gen/nat (gen/choose 0 (dec (count text-style-edits)))))]) + (every? (set kinds) [:undo :redo]) + (conj [1 (gen/return [[:undo] [:redo]])]) + (contains? (set kinds) :text) + (conj [1 (gen/fmap (fn [[index unit value]] [[:text index unit value]]) + (gen/tuple gen/nat gen/nat (gen/choose 1 2)))]) + (every? (set kinds) [:library-undo :library-redo]) + (conj [1 (gen/return [[:library-undo] [:library-redo]])]) + (every? (set kinds) [:delete :restore]) + (conj [1 (gen/fmap (fn [index] [[:delete index] [:restore index]]) gen/nat)]) + (every? (set kinds) [:edit :update-main]) + (conj [1 (gen/fmap (fn [index] [[:edit index 0 1 1] [:update-main index]]) gen/nat)]) + (every? (set kinds) [:edit :reset]) + (conj [2 (gen/fmap (fn [index] [[:edit index 1 1 :copy-head] [:reset index]]) gen/nat)]) + (every? (set kinds) [:library-edit :library-sync]) + (conj [2 (gen/fmap (fn [[index value]] + [[:library-edit index 0 value] + [:edit index 1 1 2] [:library-sync]]) + (gen/tuple gen/nat (gen/choose 0 2)))]) + (every? (set kinds) [:library-edit :library-accept :library-sync]) + (conj [2 (gen/fmap (fn [[index value]] + [[:library-edit index 0 value] [:library-accept index] [:library-sync index]]) + (gen/tuple gen/nat (gen/choose 1 2)))]) + (every? (set kinds) [:library-delete :library-restore]) + (conj [1 (gen/fmap (fn [index] + [[:library-delete index] [:library-sync] + [:library-restore index] [:library-sync]]) gen/nat)]) + (every? (set kinds) [:library-add-child :library-sync]) + (conj [1 (gen/fmap (fn [index] [[:library-add-child index] [:library-sync]]) gen/nat)]))] + (gen/fmap #(vec (mapcat identity %)) (gen/vector (gen/frequency histories) 0 40)))) + (def tuple-gen (gen/tuple (gen/elements [:edit :edit :edit :reset :update-main :detach :sync :undo :redo]) gen/nat gen/nat gen/nat gen/nat)) @@ -413,43 +882,63 @@ (def program-gen (gen/let [components (gen/choose 2 3) depth (gen/choose 0 2) - ops (gen/vector tuple-gen 0 30)] + ops (operation-gen [:edit :reset :update-main :detach :sync :undo :redo])] {:world [components depth] - ;; This executable prefix survives shrinking and guarantees the CI - ;; coverage floor even at size zero. The random tail changes ordering. - :ops (into [[:edit 0 0 1 1] [:sync 0] [:update-main 0] - [:edit 0 1 1 1] [:reset 0] [:detach 0] [:undo] [:redo]] ops)})) + :ops ops})) (def structure-kinds - [:edit :reset :update-main :detach :sync :undo :redo :text :add-child - :remove-child :duplicate :nest :delete :restore :resize :rotate]) + [:edit :reset :update-main :detach :sync :undo :redo :text :text-style :add-child + :remove-child :duplicate :nest :delete :restore :resize :rotate :style :transform]) (def structure-program-gen (gen/let [components (gen/choose 2 3) depth (gen/choose 0 2) layout (gen/elements [nil :flex :grid]) - ops (gen/vector (gen/tuple (gen/elements structure-kinds) - gen/nat gen/nat gen/nat gen/nat) 0 20)] - {:world [components depth {:text true :layout layout}] - :ops (into [[:add-child 0] [:remove-child 0] [:duplicate 0] [:nest 0] - [:delete 0] [:restore 0] [:text 0 0 1] [:text 1 1 1] - [:resize 0 0 2] [:rotate 0 0 0] [:reset 0] - [:edit 0 0 1 1] [:update-main 0] [:sync 1] - [:detach 0] [:undo] [:redo]] ops)})) + ops (operation-gen structure-kinds)] + {:world [components depth {:text true :text-styles true :layout layout}] + :ops ops})) + +(def swap-kinds (into structure-kinds [:swap :switch])) (def swap-program-gen (gen/let [components (gen/choose 2 3) differ? gen/boolean - ops (gen/vector (gen/tuple (gen/elements (into structure-kinds [:swap :switch])) - gen/nat gen/nat gen/nat gen/nat) 0 20)] - {:world [components 2 {:variants true :variant-diff differ?}] - :ops (into [[:edit 0 0 1 1] [:switch 0] [:switch 0] - [:swap 0] [:undo] [:redo] [:reset 0] - [:edit 0 1 1 1] [:update-main 0] [:sync 1]] ops)})) + layout (gen/elements [nil :flex :grid]) + ops (operation-gen swap-kinds)] + {:world [components 2 {:variants true :variant-diff differ? :rich-variants true + :text true :text-styles true :layout layout :layout-copies true}] + :ops ops})) + +(def library-kinds + (into structure-kinds [:swap :switch :library-sync])) (def library-program-gen - (gen/let [ops (gen/vector (gen/tuple (gen/elements (into structure-kinds [:swap :switch :library-sync])) - gen/nat gen/nat gen/nat gen/nat) 0 20)] - {:world [2 1 {:library true :variants true}] - :ops (into [[:edit 0 0 1 2] [:update-main 0] [:library-sync] - [:undo] [:redo] [:reset 0] [:sync 1]] ops)})) + (gen/let [depth (gen/choose 0 2) + layout (gen/elements [nil :flex :grid]) + ops (operation-gen library-kinds)] + {:world [2 depth {:library true :variants true :rich-variants true :text true :text-styles true + :layout layout :layout-copies true}] + :ops ops})) + +(def stale-library-kinds + (into (vec (remove #{:update-main} library-kinds)) (sort (disj library-source-kinds :library-accept)))) + +(def stale-library-program-gen + (gen/let [depth (gen/choose 0 2) + library-depth (gen/choose 1 2) + layout (gen/elements [nil :flex :grid]) + ops (operation-gen stale-library-kinds)] + {:world [2 depth {:library true :stale-libraries true :library-variants true + :library-depth library-depth :variants true :rich-variants true :text true :text-styles true + :layout layout :layout-copies true}] + :ops ops})) + +(def dependency-kinds + [:edit :reset :swap :sync :undo :redo :library-sync :library-edit :library-accept + :library-add-child :library-remove-child :library-delete :library-restore :library-undo :library-redo]) + +(def dependency-program-gen + (gen/let [depth (gen/choose 0 1) + ops (operation-gen dependency-kinds)] + {:world [2 depth {:library true :stale-libraries true :library-dependency true}] + :ops ops})) diff --git a/common/src/app/common/test_helpers/composable/geometry.cljc b/common/src/app/common/test_helpers/composable/geometry.cljc new file mode 100644 index 0000000000..d8b11b545e --- /dev/null +++ b/common/src/app/common/test_helpers/composable/geometry.cljc @@ -0,0 +1,57 @@ +;; 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 app.common.test-helpers.composable.geometry + "Expected geometry from authored inputs and parent frames. Only primitive + constraint and transform math is shared with production." + (:require + [app.common.geom.matrix :as gmt] + [app.common.geom.modifiers :as gm] + [app.common.geom.point :as gpt] + [app.common.geom.shapes :as gsh] + [app.common.math :as mth] + [app.common.types.modifiers :as ctm])) + +(defn- orientation-matrix + "Resize uses constraints and dimensions. Parent placement supplies axis + directions, without applying residual minimum-size scale a second time." + [shape] + (let [{:keys [a b c d]} (or (:transform shape) (gmt/matrix)) + horizontal (gpt/unit (gpt/point a b)) + vertical (gpt/unit (gpt/point c d))] + (gmt/matrix (:x horizontal) (:y horizontal) (:x vertical) (:y vertical) 0 0))) + +(defn child-placement + "Place a main child against its expected copy parent. Only lower-level + constraint and matrix math is shared with production, not sync code." + [main main-parent parent objects] + (let [resized (if (and (mth/close? (:width main-parent) (:width parent) 0.01) + (mth/close? (:height main-parent) (:height parent) 0.01)) + objects + (let [tree (gm/set-objects-modifiers + {(:id main-parent) + {:modifiers (ctm/change-size main-parent (:width parent) (:height parent))}} + objects)] + (reduce-kv (fn [objects id {:keys [modifiers]}] + (update objects id gsh/transform-shape modifiers)) objects tree))) + main (get resized (:id main)) + main-parent (get resized (:id main-parent)) + center (gsh/shape->center main-parent) + turn (gmt/multiply (orientation-matrix parent) + (gmt/inverse (orientation-matrix main-parent))) + placed (if (gmt/unit? turn) main + (gsh/apply-transform main (gmt/transform-in center turn))) + ;; Flip flags follow the parent's composition history. A single + ;; large turn can toggle both flags where several small turns do not. + flipped? (fn [key] + (odd? (count (filter identity [(get main key) (get main-parent key) + (get parent key)]))))] + (-> placed + (gsh/move (gpt/subtract (gsh/shape->center parent) center)) + (assoc :rotation (mod (+ (or (:rotation main) 0) + (- (or (:rotation parent) 0) (or (:rotation main-parent) 0))) 360) + :flip-x (flipped? :flip-x) + :flip-y (flipped? :flip-y))))) diff --git a/common/src/app/common/test_helpers/composable/oracle.cljc b/common/src/app/common/test_helpers/composable/oracle.cljc index 519c1d8915..fd131aec1e 100644 --- a/common/src/app/common/test_helpers/composable/oracle.cljc +++ b/common/src/app/common/test_helpers/composable/oracle.cljc @@ -9,13 +9,13 @@ from the shadow and near main, never from the sync implementation." (:require [app.common.geom.matrix :as gmt] - [app.common.geom.modifiers :as gm] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.common.math :as mth] [app.common.test-helpers.composable.comp.files :as cf] [app.common.test-helpers.composable.comp.undo-check :as uc] [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.composable.geometry :as geom] [app.common.test-helpers.composable.shadow :as shadow] [app.common.test-helpers.files :as thf] [app.common.test-helpers.normalize :as thn] @@ -58,123 +58,120 @@ (defn- matrix-effect "Matrix coefficients have no pixel unit. Compare their effect over the - shape's local bounds, so the geometry tolerance has the same unit." - [shape matrix] - (let [half-width (/ (:width shape) 2) - half-height (/ (:height shape) 2)] - (mapv #(gpt/transform % (or matrix (gmt/matrix))) - [(gpt/point (- half-width) (- half-height)) - (gpt/point half-width (- half-height)) - (gpt/point half-width half-height) - (gpt/point (- half-width) half-height)]))) + shape's local bounds. Keep the inputs for paired derived-axis comparison." + [shape matrix derived] + (let [bounds (select-keys shape [:width :height]) + half-width (/ (:width bounds) 2) + half-height (/ (:height bounds) 2)] + (with-meta + (mapv #(gpt/transform % (or matrix (gmt/matrix))) + [(gpt/point (- half-width) (- half-height)) + (gpt/point half-width (- half-height)) + (gpt/point half-width half-height) + (gpt/point (- half-width) half-height)]) + {::matrix matrix ::bounds bounds ::derived derived}))) + +(declare free-head-reference-origins) (defn design-snapshot "Design inputs without derived placement, dimensions and bookkeeping. Geometry remains unrounded; equivalent? applies its tolerance directly." - [situation] - (walk/postwalk - (fn [value] - (if (and (map? value) (contains? value :parent-id)) - (cond-> (-> value - (dissoc :remote-synced) - (update :flip-x boolean) - (update :flip-y boolean)) - (= :text (:type value)) (update :content thtx/view)) - value)) - (walk/postwalk - (fn [value] - (if (and (map? value) (:objects value)) - (update value :objects - (fn [objects] - (into {} (map (fn [[id shape]] - [id (-> (gsh/move shape - (gpt/point (- (get-in objects [(:parent-id shape) :x] 0)) - (- (get-in objects [(:parent-id shape) :y] 0)))) - (as-> moved (assoc moved - :transform (matrix-effect shape (:transform moved)) - :transform-inverse (matrix-effect shape (:transform-inverse moved)))) - (as-> shape (apply dissoc shape - (cond-> (derived-attributes objects shape) - (and (:component-id shape) (:shape-ref shape)) - (into #{:x :y :points :selrect})))) - (update :constraints-h #(or % (gsh/default-constraints-h shape))) - (update :constraints-v #(or % (gsh/default-constraints-v shape))))])) objects))) - value)) - (snapshot situation)))) + ([situation] (design-snapshot situation {})) + ([situation {:keys [free-head-placement relative-free-head-placement] + :or {free-head-placement true}}] + (let [origins (when (and free-head-placement relative-free-head-placement) + (free-head-reference-origins situation))] + (walk/postwalk + (fn [value] + (if (and (map? value) (contains? value :parent-id)) + (cond-> (-> value + (dissoc :remote-synced) + (update :flip-x boolean) + (update :flip-y boolean) + (update :fixed-scroll boolean)) + (= :text (:type value)) (update :content thtx/view)) + value)) + (walk/postwalk + (fn [value] + (if (and (map? value) (:objects value)) + (update value :objects + (fn [objects] + (into {} (map (fn [[id shape]] + [id (-> (gsh/move shape + (gpt/negate + (or (get origins id) + (gpt/point (get-in objects [(:parent-id shape) :x] 0) + (get-in objects [(:parent-id shape) :y] 0))))) + (as-> moved (let [derived (derived-attributes objects shape)] + (assoc moved + :transform (matrix-effect shape (:transform moved) derived) + :transform-inverse (matrix-effect shape (:transform-inverse moved) derived)))) + (as-> shape (apply dissoc shape + (cond-> (derived-attributes objects shape) + (and free-head-placement (:component-id shape) (:shape-ref shape) + (= 1 (count (ctn/get-parent-copy-heads objects shape)))) + (into #{:x :y :points :selrect})))) + (update :constraints-h #(or % (gsh/default-constraints-h shape))) + (update :constraints-v #(or % (gsh/default-constraints-v shape))))])) objects))) + value)) + (snapshot situation)))))) (defn canonical "Design data with shape, component and grid-cell IDs named by tree path. Pure and frontend backends allocate different IDs for the same action." - [situation] - (let [files (sort-by (comp str key) (snapshot situation)) - ids (atom {#uuid "00000000-0000-0000-0000-000000000000" :root})] - (letfn [(name-tree [objects id path] - (when-let [shape (get objects id)] - (swap! ids assoc id path) - (doseq [[cell-id cell] (:layout-grid-cells shape)] - (swap! ids assoc cell-id [path :cell (:row cell) (:column cell)])) - (doseq [[index child] (map-indexed vector (:shapes shape))] - (name-tree objects child (conj path index)))))] - (doseq [[file-index [file-id file]] (map-indexed vector files)] - (swap! ids assoc file-id [:file file-index]) - (doseq [[page-index page-id] (map-indexed vector (get-in file [:data :pages])) - :let [page (get-in file [:data :pages-index page-id])]] - (swap! ids assoc page-id [:file file-index :page page-index]) - (doseq [[index child] (map-indexed vector (get-in page [:objects #uuid "00000000-0000-0000-0000-000000000000" :shapes]))] - (name-tree (:objects page) child [:file file-index :page page-index index]))) - (doseq [[index [component-id component]] - (map-indexed vector (sort-by (comp str key) (get-in file [:data :components]))) - :let [path [:file file-index :component index]]] - (swap! ids assoc component-id path) - (when (:objects component) - (name-tree (:objects component) (:main-instance-id component) (conj path :main))))) - (walk/postwalk #(if (uuid? %) (get @ids % %) %) (design-snapshot situation))))) + ([situation] (canonical situation {})) + ([situation opts] + (let [files (sort-by (comp str key) (snapshot situation)) + ids (atom {#uuid "00000000-0000-0000-0000-000000000000" :root})] + (letfn [(name-tree [objects id path] + (when-let [shape (get objects id)] + (swap! ids assoc id path) + (doseq [[cell-id cell] (:layout-grid-cells shape)] + (swap! ids assoc cell-id [path :cell (:row cell) (:column cell)])) + (doseq [[index child] (map-indexed vector (:shapes shape))] + (name-tree objects child (conj path index)))))] + (doseq [[file-index [file-id file]] (map-indexed vector files)] + (swap! ids assoc file-id [:file file-index]) + (doseq [[page-index page-id] (map-indexed vector (get-in file [:data :pages])) + :let [page (get-in file [:data :pages-index page-id])]] + (swap! ids assoc page-id [:file file-index :page page-index]) + (doseq [[index child] (map-indexed vector (get-in page [:objects #uuid "00000000-0000-0000-0000-000000000000" :shapes]))] + (name-tree (:objects page) child [:file file-index :page page-index index]))) + (doseq [[index [component-id component]] + (map-indexed vector (sort-by (comp str key) (get-in file [:data :components]))) + :let [path [:file file-index :component index]]] + (swap! ids assoc component-id path) + (when (:objects component) + (name-tree (:objects component) (:main-instance-id component) (conj path :main))))) + (walk/postwalk #(if (uuid? %) (get @ids % %) %) (design-snapshot situation opts)))))) + +(defn- paired-matrix-effects + [shape other] + (reduce + (fn [shape attr] + (let [{:keys [::matrix ::bounds ::derived]} (meta (get shape attr)) + other-bounds (::bounds (meta (get other attr)))] + (if (or (not-any? derived [:width :height]) (= bounds other-bounds)) + shape + (let [bounds (reduce (fn [bounds axis] + (cond-> bounds + (contains? derived axis) + (assoc axis (max (get bounds axis) (get other-bounds axis))))) + bounds [:width :height])] + (assoc shape attr (matrix-effect bounds matrix derived)))))) + shape [:transform :transform-inverse])) (defn equivalent? - "Compare canonical data, allowing 0.01 only within shape geometry." + "Compare design data, allowing 0.01 only within shape geometry. Compare + matrices over common derived dimensions, retaining each fixed dimension." [expected actual] - (uc/same-state? expected actual 0.01)) - -(defn- orientation-matrix - "Resize uses constraints and dimensions. Parent placement supplies axis - directions, without applying residual minimum-size scale a second time." - [shape] - (let [{:keys [a b c d]} (or (:transform shape) (gmt/matrix)) - horizontal (gpt/unit (gpt/point a b)) - vertical (gpt/unit (gpt/point c d))] - (gmt/matrix (:x horizontal) (:y horizontal) (:x vertical) (:y vertical) 0 0))) - -(defn- child-placement - "Place a main child against its expected copy parent. Only lower-level - constraint and matrix math is shared with production, not sync code." - [main main-parent parent objects] - (let [resized (if (and (mth/close? (:width main-parent) (:width parent) 0.01) - (mth/close? (:height main-parent) (:height parent) 0.01)) - objects - (let [tree (gm/set-objects-modifiers - {(:id main-parent) - {:modifiers (ctm/change-size main-parent (:width parent) (:height parent))}} - objects)] - (reduce-kv (fn [objects id {:keys [modifiers]}] - (update objects id gsh/transform-shape modifiers)) objects tree))) - main (get resized (:id main)) - main-parent (get resized (:id main-parent)) - center (gsh/shape->center main-parent) - turn (gmt/multiply (orientation-matrix parent) - (gmt/inverse (orientation-matrix main-parent))) - placed (if (gmt/unit? turn) main - (gsh/apply-transform main (gmt/transform-in center turn))) - ;; Flip flags follow the parent's composition history. A single - ;; large turn can toggle both flags where several small turns do not. - flipped? (fn [key] - (odd? (count (filter identity [(get main key) (get main-parent key) - (get parent key)]))))] - (-> placed - (gsh/move (gpt/subtract (gsh/shape->center parent) center)) - (assoc :rotation (mod (+ (or (:rotation main) 0) - (- (or (:rotation parent) 0) (or (:rotation main-parent) 0))) 360) - :flip-x (flipped? :flip-x) - :flip-y (flipped? :flip-y))))) + (if (and (map? expected) (map? actual)) + (and (= (set (keys expected)) (set (keys actual))) + (if (and (contains? expected :parent-id) (contains? actual :parent-id)) + (uc/same-state? (paired-matrix-effects expected actual) + (paired-matrix-effects actual expected) 0.01) + (every? #(equivalent? (get expected %) (get actual %)) (keys expected)))) + (uc/same-state? expected actual 0.01))) (defn- with-derived-geometry [objects shape expected] @@ -190,50 +187,76 @@ (if (contains? derived :y) (- (:y shape) (:y expected)) 0))))) (defn expected-geometry - [file container libraries shape] - (let [objects (:objects container)] - (letfn [(expected [shape visited] - (when (contains? visited (:id shape)) - (fail :I1 {:shape (:name shape) :reason :parent-cycle})) - (if (contains? (:touched shape) :geometry-group) - shape - (let [main (ctf/find-ref-shape file container libraries shape :with-context? true) - parent (get objects (:parent-id shape)) - main-objects (get-in (meta main) [:container :objects]) - main-parent (get main-objects (:parent-id main)) - placed (cond - (nil? main) shape - (and (:shape-ref parent) main-parent) - (child-placement main main-parent (expected parent (conj visited (:id shape))) - main-objects) - :else - ;; Ordinary parents left by detach still place their nested copies. - (let [turn (gmt/multiply (or (:transform shape) (gmt/matrix)) - (or (:transform-inverse main) (gmt/matrix))) - placed (if (gmt/unit? turn) main - (gsh/apply-transform main (gmt/transform-in (gsh/shape->center main) turn)))] - (-> placed - (gsh/move (gpt/subtract (gsh/shape->center shape) (gsh/shape->center placed))) - ;; This is the placement matrix just applied. - ;; Re-decomposing a .01px frame can add scale - ;; noise that grows in its larger children. - (assoc :transform (:transform shape) - :transform-inverse (:transform-inverse shape) - :rotation (:rotation shape) - :flip-x (:flip-x shape) :flip-y (:flip-y shape))))) - content (when (ctk/swapped? shape) - (ctf/find-content-ref-shape file container libraries shape)) - placed (if content - ;; Content supplies size; the position source - ;; still owns the untransformed top-left anchor. - (-> placed - (gsh/transform-shape - (ctm/change-size placed (:width content) (:height content))) - (gsh/absolute-move (gpt/point (get-in placed [:selrect :x]) - (get-in placed [:selrect :y])))) - placed)] - (with-derived-geometry objects shape placed))))] - (expected shape #{})))) + ([file container libraries shape] + (expected-geometry file container libraries shape (constantly libraries))) + ([file container libraries shape libraries-for-shape] + (let [objects (:objects container)] + (letfn [(expected [shape visited] + (when (contains? visited (:id shape)) + (fail :I1 {:shape (:name shape) :reason :parent-cycle})) + (if (contains? (:touched shape) :geometry-group) + shape + (let [libraries (libraries-for-shape shape) + main (ctf/find-ref-shape file container libraries shape :include-deleted? true :with-context? true) + parent (get objects (:parent-id shape)) + main-objects (get-in (meta main) [:container :objects]) + main-parent (get main-objects (:parent-id main)) + placed (cond + (nil? main) shape + (and (:shape-ref parent) main-parent) + (geom/child-placement main main-parent (expected parent (conj visited (:id shape))) + main-objects) + :else + ;; Ordinary parents left by detach still place their nested copies. + (let [turn (gmt/multiply (or (:transform shape) (gmt/matrix)) + (or (:transform-inverse main) (gmt/matrix))) + placed (if (gmt/unit? turn) main + (gsh/apply-transform main (gmt/transform-in (gsh/shape->center main) turn)))] + (-> placed + (gsh/move (gpt/subtract (gsh/shape->center shape) (gsh/shape->center placed))) + ;; This is the placement matrix just applied. + ;; Re-decomposing a .01px frame can add scale + ;; noise that grows in its larger children. + (assoc :transform (:transform shape) + :transform-inverse (:transform-inverse shape) + :rotation (:rotation shape) + :flip-x (:flip-x shape) :flip-y (:flip-y shape))))) + content (when (ctk/swapped? shape) + (ctf/find-content-ref-shape file container libraries shape :include-deleted? true)) + placed (if content + ;; Content supplies size; the position source + ;; still owns the untransformed top-left anchor. + (-> placed + (gsh/transform-shape + (ctm/change-size placed (:width content) (:height content))) + (gsh/absolute-move (gpt/point (get-in placed [:selrect :x]) + (get-in placed [:selrect :y])))) + placed)] + (with-derived-geometry objects shape placed))))] + (expected shape #{}))))) + +(defn- free-head-reference-origins + "Backend parity permits a free head's placement to differ after reflow. + Its untouched images compare offsets from their expected source frame, + so inherited placement can differ while a drifted image still fails. + Strict same-run sync comparison never uses these origins." + [situation] + (into {} + (for [[file-id file] (cf/all-files situation) + page (vals (get-in file [:data :pages-index])) + [id shape] (:objects page) + :when (and (:component-id shape) (:shape-ref shape) + (not (ctk/touched-group? shape :geometry-group)) + (> (count (ctn/get-parent-copy-heads (:objects page) shape)) 1)) + :let [libraries (cf/reference-libraries situation file-id id) + source (ctf/find-ref-shape file page libraries shape + :include-deleted? true :with-context? true) + source-objects (get-in (meta source) [:container :objects])] + :when (and (:component-id source) (:shape-ref source) + (= 1 (count (ctn/get-parent-copy-heads source-objects source)))) + :let [expected (expected-geometry file page libraries shape + #(cf/reference-libraries situation file-id (:id %)))]] + [id (gpt/point (:x expected) (:y expected))]))) (defn- geometry-differences [objects shape expected] @@ -253,10 +276,16 @@ (and (not layout-child) (not auto-width) (not auto-height) (not (gsh/close-attrs? :points (:points shape) (:points expected) 0.01))) (conj :points)))) +(defn check-requested-geometry + [objects actual expected] + (when-let [attrs (seq (geometry-differences objects actual expected))] + (fail :I9 {:phase :requested-geometry :attrs (set attrs) + :shape (:name actual) :expected expected :actual actual}))) + (defn- comparable-values [shape context group] (let [shape (if (= group :constraints-group) - (cond-> shape + (cond-> (update shape :fixed-scroll boolean) (nil? (:constraints-h shape)) (assoc :constraints-h (gsh/default-constraints-h context)) (nil? (:constraints-v shape)) (assoc :constraints-v (gsh/default-constraints-v context))) shape)] @@ -270,15 +299,84 @@ (sort-by (juxt :row :column)) vec))) +(defn- expected-grid-cells + "Source cells with the copy's hidden/absolute children removed. A gap, + manual cell or span ends the automatic prefix; visible children without + a source cell take free cells in grid order. No production assignment + helper supplies these expectations." + [objects shape main] + (let [flow-order (if (= :row (:layout-grid-dir main)) + (juxt :row :column) + (juxt :column :row)) + participating (into #{} + (keep-indexed (fn [index id] + (let [child (get objects id)] + (when-not (or (:hidden child) (:layout-item-absolute child)) + index)))) + (:shapes shape)) + end-auto-prefix + (fn [cells] + (second + (reduce (fn [[ended result] cell] + (let [span (or (not= 1 (:row-span cell)) (not= 1 (:column-span cell))) + occupied (seq (:shapes cell)) + manual (or (= :manual (:position cell)) span + (and ended occupied (= :auto (:position cell))))] + [(or ended manual (not occupied)) + (conj result (cond-> cell + (and manual (= :auto (:position cell))) + (assoc :position :manual)))])) + [false []] cells))) + cells (->> (grid-cells main) + (sort-by flow-order) + (mapv #(update % :shapes (fn [ids] (filterv participating ids)))) + end-auto-prefix) + assigned (into #{} (mapcat :shapes) cells) + missing (remove assigned (sort participating)) + [cells _] (reduce (fn [[result pending] cell] + (if (and (seq pending) (empty? (:shapes cell))) + [(conj result (assoc cell :position :auto :shapes [(first pending)])) + (rest pending)] + [(conj result cell) pending])) + [[] missing] cells)] + (->> cells end-auto-prefix (sort-by (juxt :row :column)) vec))) + (defn- check-structure [objects shape main] (let [refs (mapv #(get-in objects [% :shape-ref]) (:shapes shape))] (when-not (= (vec (:shapes main)) refs) (fail :I4 {:shape (:name shape) :group :structure :expected (:shapes main) :actual refs})) - (when (and (= :grid (:layout main)) (not= (grid-cells shape) (grid-cells main))) - (fail :I4 {:shape (:name shape) :group :layout-grid-cells - :expected (grid-cells main) :actual (grid-cells shape)})))) + (when (= :grid (:layout main)) + (let [expected (expected-grid-cells objects shape main) + actual (grid-cells shape)] + (when-not (= expected actual) + (fail :I4 {:shape (:name shape) :group :layout-grid-cells + :expected expected :actual actual})))))) + +(defn- inherited-layout-item? + "A root's placement in an unrelated flex/grid belongs to that placement. + Layout child attrs inherit only through corresponding layout parents; + intrinsic fix/auto sizing also belongs to the component itself." + [file container libraries shape group] + (let [source (ctf/find-ref-shape file container libraries shape :include-deleted? true :with-context? true) + source-objects (get-in (meta source) [:container :objects]) + parent (get (:objects container) (:parent-id shape)) + source-parent (get source-objects (:parent-id source))] + (or (ctk/swapped? shape) + (and (#{:layout-item-h-sizing :layout-item-v-sizing} group) + (#{:auto :fix} (get source group))) + (and (:layout source-parent) (:layout parent) + (= (:id source-parent) (:shape-ref parent)))))) + +(defn- mixed-typography-ownership? + "A reference cannot describe styles split between the copy and main." + [touched] + (let [copy-reference? (contains? touched :text-content-typography)] + (boolean + (some #(not= copy-reference? (contains? touched %)) + [:text-content-family :text-content-weight :text-content-size + :text-content-line-height :text-content-spacing :text-content-case])))) (defn- check-file "I1–I4 and I9. Before settlement only authored groups/values are checked; @@ -286,32 +384,34 @@ ([situation model] (check-file situation model true)) ([situation model settled] (let [file (tm/file situation) - libraries (assoc (tm/aux-files situation) (:id file) file)] + libraries (cf/libraries situation)] (when settled (thf/validate-file! file libraries)) (doseq [page (vals (get-in file [:data :pages-index])) :let [container (ctn/make-container page :page)] shape (vals (:objects page)) - :when (:shape-ref shape) - :let [expected (get model (:id shape) {}) + :let [libraries (cf/reference-libraries situation shape) + expected (if (:shape-ref shape) (get model (:id shape) {}) {}) touched (set (:touched shape))]] (when-not (= (set (keys expected)) touched) (fail (if (some #(not (contains? expected %)) touched) :I2 :I3) {:shape (:name shape) :expected (set (keys expected)) :actual touched})) (doseq [[group value] expected] - (when-not (shadow/same-value? shape group value) + (when-not (shadow/same-value? shape group value (:objects page)) (fail :I9 {:shape (:name shape) :group group :expected value :actual (shadow/values shape group)}))) - (when settled - (when-let [main (ctf/find-content-ref-shape file container libraries shape)] + (when (and settled (:shape-ref shape)) + (when-let [main (ctf/find-content-ref-shape file container libraries shape :include-deleted? true)] (check-structure (:objects page) shape main) (doseq [group (keys shadow/attributes) :when (and (not= group :geometry-group) (not (contains? touched group))) :when (not (and (= group :name-group) (= :text (:type shape)) (= (:name main) (txt/generate-shape-name (txt/content->text (:content main)))))) + :when (or (not (.startsWith (name group) "layout-item-")) + (inherited-layout-item? file container libraries shape group)) ;; A copy root's name follows component renaming too. :let [source (if (or (= group :constraints-group) (.startsWith (name group) "layout-item-")) - (or (ctf/find-ref-shape file container libraries shape) main) + (or (ctf/find-ref-shape file container libraries shape :include-deleted? true) main) main) expected (comparable-values source shape group) actual (comparable-values shape shape group)]] @@ -319,12 +419,20 @@ (fail :I4 {:shape (:name shape) :group group :expected expected :actual actual}))) (when (= :text (:type shape)) - (doseq [unit (thtx/override-units (:content main) (:content shape)) - :let [group (some (fn [[group candidate]] (when (= unit candidate) group)) shadow/text-groups)] - :when (not (contains? touched group))] - (fail :I4 {:shape (:name shape) :group group :unit unit})))) + (let [drop-reference? (mixed-typography-ownership? touched)] + (when (and drop-reference? + (some #(or (:typography-ref-id %) (:typography-ref-file %)) + (tree-seq map? :children (:content shape)))) + (fail :I4 {:shape (:name shape) :group :text-content-typography + :unit :typography :expected nil})) + (doseq [unit (thtx/override-units (:content main) (:content shape)) + :when (not (and drop-reference? (= :typography unit))) + :let [group (some (fn [[group candidate]] (when (= unit candidate) group)) shadow/text-groups)] + :when (not (contains? touched group))] + (fail :I4 {:shape (:name shape) :group group :unit unit}))))) (when-not (contains? touched :geometry-group) - (let [expected (expected-geometry file container libraries shape) + (let [expected (expected-geometry file container libraries shape + #(cf/reference-libraries situation %)) attrs (geometry-differences (:objects page) shape expected)] (when (seq attrs) (fail :I4 {:shape (:name shape) :group :geometry-group :attrs attrs diff --git a/common/src/app/common/test_helpers/composable/shadow.cljc b/common/src/app/common/test_helpers/composable/shadow.cljc index 065139af60..5b8058b8d8 100644 --- a/common/src/app/common/test_helpers/composable/shadow.cljc +++ b/common/src/app/common/test_helpers/composable/shadow.cljc @@ -8,20 +8,48 @@ "Authored overrides, kept independently of production touched writes. Each shape id maps groups to the attribute values the user authored." (:require + [app.common.geom.shapes :as gsh] [app.common.math :as mth] [app.common.test-helpers.composable.comp.nodes :as n] - [app.common.test-helpers.texts :as thtx])) + [app.common.test-helpers.composable.geometry :as geom] + [app.common.test-helpers.texts :as thtx] + [app.common.types.container :as ctn])) ;; This table is a specification, deliberately not ctk/sync-attrs. (def groups - {:fills :fill-group :opacity :layer-effects-group :name :name-group}) + {:fills :fill-group :opacity :layer-effects-group :name :name-group + :strokes :stroke-group :hidden :visibility-group :blocked :modifiable-group + :r1 :radius-group :blend-mode :layer-effects-group :hide-fill-on-export :fill-group + :show-content :show-content :fixed-scroll :constraints-group + :constraints-h :constraints-group :constraints-v :constraints-group + :layout-item-margin :layout-item-margin :layout-gap :layout-gap + :layout-padding :layout-padding :layout-align-items :layout-align-items}) + +(defn attribute-applicable? + "The clipping and background-export controls belong to frames." + [shape attr] + (case attr + (:show-content :hide-fill-on-export) (= :frame (:type shape)) + true)) (def attributes {:fill-group [:fills :hide-fill-on-export] :layer-effects-group [:opacity :blend-mode] :name-group [:name] + :stroke-group [:strokes] + :radius-group [:r1 :r2 :r3 :r4] + :visibility-group [:hidden] + :modifiable-group [:blocked] + :shadow-group [:shadow] + :blur-group [:blur :background-blur] + :mask-group [:masked-group] + :exports-group [:exports] + :grids-group [:grids] + :show-content [:show-content] + :content-group [:bool-type :bool-content] :geometry-group [:width :height :rotation :flip-x :flip-y :content-scale] - :text-font-group [:grow-type] + :text-font-group [:grow-type :font-family :font-size :font-style :font-weight] + :text-display-group [:letter-spacing :line-height :text-align] :constraints-group [:constraints-h :constraints-v :fixed-scroll] :layout-container [:layout] :layout-grid-dir [:layout-grid-dir] @@ -46,6 +74,15 @@ :layout-item-z-index [:layout-item-z-index] :layout-item-align-self [:layout-item-align-self]}) +;; These fields need geometry, content or cell-reference comparisons instead +;; of raw equality. Keep the inventory explicit so new production attrs cannot +;; silently fall outside the oracle's specification. +(def specialized-attributes + {:geometry-group [:type :selrect :points :locked :proportion :proportion-lock + :x :y :transform :transform-inverse :content] + :content-group [:content :position-data] + :layout-grid-cells [:layout-grid-cells]}) + (def text-groups {:text-content-text :letters :text-content-family :family :text-content-weight :weight :text-content-size :size :text-content-line-height :line-height :text-content-spacing :spacing @@ -59,30 +96,55 @@ {:content (:content shape)} (into {} (map #(vector % (get shape %))) (get attributes group)))) +(defn author-geometry + [shape parent] + (cond-> (values shape :geometry-group) + parent (with-meta {::position {:shape shape :parent parent}}))) + +(defn- authored-placement + [expected parent] + (when-let [{authored :shape origin :parent} (::position (meta expected))] + ;; Placement of this child does not depend on its siblings' identities. + ;; Keep the expected tree self-contained across frontend ID allocation. + (geom/child-placement authored origin parent + {(:id authored) (assoc authored :parent-id (:id origin) :shapes []) + (:id origin) (assoc origin :shapes [(:id authored)])}))) + (defn same-value? - [shape group expected] - (if-let [unit (get text-groups group)] - (not (contains? (thtx/override-units (:content expected) (:content shape)) unit)) - (if (= group :geometry-group) - (every? (fn [[key value]] - (let [actual (get shape key)] - (cond - (#{:flip-x :flip-y} key) (= (boolean value) (boolean actual)) - (and (number? value) (number? actual)) (mth/close? value actual 1e-10) - :else (= value actual)))) expected) - (= expected (values shape group))))) + ([shape group expected] (same-value? shape group expected nil)) + ([shape group expected objects] + (if (and (= :text (:type shape)) (= :content-group group)) + ;; Text values are checked per style/letter unit. The parent group is + ;; only a marker; boolean content uses the ordinary attribute table. + true + (if-let [unit (get text-groups group)] + (not (contains? (thtx/override-units (:content expected) (:content shape)) unit)) + (if (= group :geometry-group) + (and (if-let [placed (when objects + (authored-placement expected (get objects (:parent-id shape))))] + (gsh/close-attrs? :points (:points shape) (:points placed) 0.01) + true) + (every? (fn [[key value]] + (let [actual (get shape key)] + (cond + (#{:flip-x :flip-y} key) (= (boolean value) (boolean actual)) + (and (number? value) (number? actual)) (mth/close? value actual 1e-10) + :else (= value actual)))) expected)) + (= expected (values shape group))))))) (defn edit-text - [model before content] - (if (:shape-ref before) - (let [units (thtx/override-units (:content before) content)] - (reduce (fn [model [group unit]] - (cond-> model - (contains? units unit) - (assoc-in [(:id before) group] {:content content}))) - (cond-> model (seq units) (assoc-in [(:id before) :content-group] {})) - text-groups)) - model)) + ([model before content] (edit-text model before content false)) + ([model before content typography] + (if (:shape-ref before) + (let [units (cond-> (thtx/override-units (:content before) content) + typography (into #{:family :weight :size :line-height :spacing :case :typography}))] + (reduce (fn [model [group unit]] + (cond-> model + (contains? units unit) + (assoc-in [(:id before) group] {:content content}))) + (cond-> model (seq units) (assoc-in [(:id before) :content-group] {})) + text-groups)) + model))) (defn duplicate [model before source-id after copy-id] @@ -149,11 +211,27 @@ (= (:shape-ref shape) (:shape-ref (get before id))) (get model id) (and (contains? (get model id) :swap-group) + (= 1 (count (ctn/get-parent-copy-heads after shape))) (= (:component-id shape) (:component-id (get after (:shape-ref shape))))) - ;; Leaving the enclosing copy makes this a plain - ;; copy of its own main, without position inheritance. - (dissoc (get model id) :swap-group) + ;; The old position no longer supplies placement. + ;; Predict retained ownership from the before-state. + (let [old (get before id) + main (get before (:shape-ref shape)) + normalized (fn [source] + (-> source + (update :constraints-h #(or % (gsh/default-constraints-h old))) + (update :constraints-v #(or % (gsh/default-constraints-v old))) + (update :fixed-scroll boolean)))] + (reduce (fn [groups group] + (if (= (values (normalized old) group) + (values (normalized main) group)) + groups + (assoc groups group (values old group)))) + (dissoc (get model id) :swap-group) + (filter #(or (= :constraints-group %) + (.startsWith (name %) "layout-item-")) + (keys attributes)))) :else (inherit (get before id)))) result (cond-> (dissoc result id) (seq groups) (assoc id groups))] (reduce visit result (:shapes (get before id)))))] @@ -234,7 +312,10 @@ new-parent (get after (:parent-id shape))] (if (and (:geometry-group groups) old shape (= (:parent-id old) (:parent-id shape)) parent new-parent) - (update-in result [id :geometry-group] in-orientation parent new-parent) + (if-let [expected (authored-placement (:geometry-group groups) new-parent)] + (assoc-in result [id :geometry-group] + (with-meta (values expected :geometry-group) (meta (:geometry-group groups)))) + (update-in result [id :geometry-group] in-orientation parent new-parent)) result))) model model)) @@ -319,19 +400,26 @@ old-main (or old-main (get old-by-path path))] (reduce-kv (fn [result group _] - (let [attrs (get attributes group) - carried (filter (fn [attr] - (let [old-value (get old-main attr) - new-value (get main attr) - agree? (if (and (= group :geometry-group) - (number? old-value) (number? new-value)) - (mth/close? old-value new-value) - (= old-value new-value))] - (and agree? (not= (get old attr) new-value)))) attrs)] + (if-let [unit (get text-groups group)] (cond-> result - (seq carried) - (assoc-in [(:id shape) group] - (merge (values main group) (select-keys old carried)))))) + (and (not (contains? (thtx/override-units (:content old-main) (:content main)) unit)) + (not (same-value? main group {:content (:content old)}))) + (-> (assoc-in [(:id shape) group] {:content (:content old)}) + (assoc-in [(:id shape) :content-group] {}))) + (let [attrs (get attributes group) + carried (filter (fn [attr] + (let [old-value (get old-main attr) + new-value (get main attr) + agree? (if (and (= group :geometry-group) + (number? old-value) (number? new-value)) + (mth/close? old-value new-value) + (= old-value new-value))] + (and (attribute-applicable? main attr) + agree? (not= (get old attr) new-value)))) attrs)] + (cond-> result + (seq carried) + (assoc-in [(:id shape) group] + (merge (values main group) (select-keys old carried))))))) result (dissoc groups :swap-group))) result))) cleared (subtree-shapes after root-id))) diff --git a/common/src/app/common/test_helpers/composable/variants.cljc b/common/src/app/common/test_helpers/composable/variants.cljc new file mode 100644 index 0000000000..f5a50e00ad --- /dev/null +++ b/common/src/app/common/test_helpers/composable/variants.cljc @@ -0,0 +1,88 @@ +;; 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 app.common.test-helpers.composable.variants + "Variant fixture diversity and an independent nearest-member prediction." + (:require + [app.common.files.changes-builder :as pcb] + [app.common.geom.shapes :as gsh] + [app.common.logic.shapes :as cls] + [app.common.test-helpers.components :as thc] + [app.common.test-helpers.composable.comp.nodes :as n] + [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.test-helpers.shapes :as ths] + [app.common.test-helpers.texts :as thtx] + [app.common.types.modifiers :as ctm] + [clojure.string :as str])) + +(defn members + [color rich? differ?] + (cond-> [["a" color] ["b" (if differ? "#ff0000" color)]] + rich? (into [["c" "#00ff00"] ["d" color]]))) + +(defn diversify + "Build four members before any copies exist: varied bounds, a missing, + extra or renamed icon, shared/different text, and three properties." + [situation set-name] + (let [members (:members (n/variant-set situation set-name)) + properties [["Small" "Idle" "Light"] ["Large" "Idle" "Dark"] + ["Small" "Pressed" "Dark"] ["Large" "Pressed" "Light"]]] + (tm/with-file situation + (thf/validate-file! + (reduce + (fn [file [index {:keys [component-label root-label rect-label]}]] + (let [root-id (thi/id root-label) + page (thf/current-page file) + size (nth [[100 100] [140 100] [120 140] [80 100]] index) + changes (cls/generate-update-shapes + (pcb/empty-changes nil (:id page)) [root-id] + #(gsh/transform-shape % (apply ctm/change-size % size)) + (:objects page) {}) + props (mapv (fn [name value] {:name name :value value}) + ["Size" "State" "Theme"] (nth properties index)) + file (-> (thf/apply-changes file changes :validate? false) + (thc/update-component component-label {:variant-properties props}) + (ths/update-shape root-label :variant-name (str/join ", " (map :value props))) + (ths/update-shape rect-label :name (if (= index 2) "Glyph" "Icon")) + (ths/update-shape rect-label :constraints-h (nth [:left :leftright :scale :center] index))) + file (if (= index 3) + (let [page (thf/current-page file)] + (thf/apply-changes file + (second (cls/generate-delete-shapes (pcb/empty-changes nil (:id page)) + (:data file) page (:objects page) #{(thi/id rect-label)} {})) + :validate? false)) + file) + text-label (keyword (str (name root-label) "-caption")) + text (if (= index 2) "Other text" "Same text") + content (thtx/content [[[text {:size (if (= index 2) 22 14)}]]])] + (cond-> (ths/add-sample-shape file text-label :type :text :name "Caption" + :parent-label root-label :width 70 :height 25 + :grow-type :auto-height :content content) + (= index 1) + (ths/add-sample-shape (keyword (str (name root-label) "-badge")) + :type :rect :name "Badge" :width 12 :height 12 :parent-label root-label)))) + (tm/file situation) (map-indexed vector members)))))) + +(defn nearest + "Prefer matches in earlier unchanged properties, then container order. + This predicts the contract without calling the production distance or + target-selection functions." + [library shape pos value] + (let [data (:data library) + origin (get-in data [:components (:component-id shape)]) + properties (:variant-properties origin) + objects (get-in data [:pages-index (:main-instance-page origin) :objects]) + roots (get-in objects [(:variant-id origin) :shapes]) + members (keep #(get-in data [:components (get-in objects [% :component-id])]) roots)] + (when (not= value (get-in properties [pos :value])) + (first + (sort-by (fn [candidate] + (mapv (fn [index property] + (if (or (= index pos) (= property (nth (:variant-properties candidate) index))) 0 1)) + (range) properties)) + (filter #(and (not (:deleted %)) (= value (get-in % [:variant-properties pos :value]))) members)))))) diff --git a/common/test/common_tests/logic/composable_gen_test.cljc b/common/test/common_tests/logic/composable_gen_test.cljc index 1b060ec332..93376114d6 100644 --- a/common/test/common_tests/logic/composable_gen_test.cljc +++ b/common/test/common_tests/logic/composable_gen_test.cljc @@ -6,7 +6,13 @@ (ns common-tests.logic.composable-gen-test (:require + [app.common.files.changes-builder :as pcb] + [app.common.geom.point :as gpt] + [app.common.geom.shapes :as gsh] + [app.common.logic.shapes :as cls] + [app.common.logic.variants :as clv] [app.common.schema.test :as smt] + [app.common.test-helpers.composable.comp.files :as cf] [app.common.test-helpers.composable.comp.nodes :as n] [app.common.test-helpers.composable.comp.runner :as r] [app.common.test-helpers.composable.comp.setups :as setup] @@ -14,12 +20,515 @@ [app.common.test-helpers.composable.gen :as cg] [app.common.test-helpers.composable.oracle :as oracle] [app.common.test-helpers.composable.shadow :as shadow] + [app.common.test-helpers.composable.variants :as variants] + [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] + [app.common.test-helpers.texts :as thtx] [clojure.test :as t])) (t/use-fixtures :each thi/test-fixture) +(t/deftest nesting-a-swapped-copy-in-a-blocked-main-authors-its-lock + (t/is (map? (cg/run {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:style 3 2 1] [:swap 0 0 0 0] [:nest 0 0 0 0] + [:undo] [:redo]]})))) + +(t/deftest nesting-lock-expectations-reject-a-missing-lock-or-override + (let [state (reduce cg/step + (cg/initial-state [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}]) + [[:style 3 2 1] [:swap 0 0 0 0]]) + id (get-in (cg/resolve-op (:situation state) (:model state) [:nest 0]) [:shape :id]) + nested (-> state (cg/step [:nest 0]) cg/settle-state) + situation (:situation nested) + model (:model nested) + file (tm/file situation) + path [:data :pages-index (:id (thf/current-page file)) :objects id] + invariant (fn [file] + (try (oracle/check (tm/with-file situation file) model) nil + (catch #?(:clj Exception :cljs js/Error) error + (:invariant (ex-data error)))))] + (t/is (= {:blocked true} (get-in model [id :modifiable-group]))) + (t/is (= :I9 (invariant (assoc-in file (conj path :blocked) false)))) + (t/is (= :I3 (invariant (update-in file (conj path :touched) disj :modifiable-group)))))) + +(t/deftest generated-swap-can-target-a-loaded-library-component + (t/is (map? (cg/run {:world [2 0 {:library true :stale-libraries true + :library-variants true :variants true}] + :ops [[:delete 0] [:swap 3]]})))) + +(t/deftest scalar-style-edits-author-their-own-group-and-propagate-from-mains + (doseq [property (range 14)] + (let [result (cg/run {:world [2 1 {:layout :flex}] + :ops [[:style 0 property 1 1] [:style 1 property 1 0] + [:sync] [:undo] [:redo]]})] + (t/is (pos? (get-in result [:coverage :random :style :changed] 0)) + (str "style property " property))))) + +(t/deftest frame-only-styles-target-frames-in-each-edit-scope + (let [situation (cg/world [2 1 {:library true :text true}])] + (doseq [property [5 6] scope [0 1 2]] + (let [resolved (cg/resolve-op situation {} [:style 1 property 1 scope])] + (t/is (= :frame (get-in resolved [:shape :type])) + (str "property " property ", scope " scope)))))) + +(t/deftest text-style-edits-cover-every-style-unit + (doseq [[unit group] (map-indexed vector + [:text-content-family :text-content-weight :text-content-size + :text-content-line-height :text-content-spacing :text-content-decoration + :text-content-case :text-content-fills :text-content-typography + :text-content-align :text-content-direction :text-content-valign])] + (let [result (cg/run {:world [2 1 {:text true :text-styles true}] + :ops [[:text-style 1 unit 1] [:sync] [:undo] [:redo]]}) + id (thi/id :copy-child)] + (t/is (= 1 (get-in result [:coverage :random :text-style :changed])) (str group)) + (t/is (contains? (get (:model result) id) group) (str group))))) + +(t/deftest text-style-intent-rejects-a-dropped-main-commit + (doseq [unit (range 12)] + (let [initial (cg/initial-state [2 1 {:text true :text-styles true}])] + (t/is (= {:invariant :I9 :phase :requested-text} + (try (with-redefs [r/step (fn [situation _] situation)] + (cg/step initial [:text-style 0 unit 1])) + nil + (catch #?(:clj Exception :cljs js/Error) error + (select-keys (ex-data error) [:invariant :phase])))) + (str "text unit " unit))))) + +(t/deftest library-dependencies-wait-for-each-consumers-acceptance + (let [initial (cg/initial-state [2 0 {:library true :stale-libraries true :library-dependency true}]) + situation (:situation initial) + files (tm/aux-files situation) + source-id (some (fn [[id file]] (when (= "random-library" (:name file)) id)) files) + dependent-id (some (fn [[id file]] (when (= "dependent-library" (:name file)) id)) files) + source-shape (some #(when (and (= :rect (get-in % [:shape :type])) + (nil? (get-in % [:shape :shape-ref]))) (:shape %)) + (cg/tree (tm/with-file situation (get files source-id)))) + source-index (some #(when (= (:id source-shape) + (:id (:shape (cg/resolve-op situation {} [:library-edit % 0 1])))) %) (range 20)) + dependent-child (some #(when (= (:id source-shape) (get-in % [:shape :shape-ref])) (:shape %)) + (cg/tree (tm/with-file situation (get files dependent-id)))) + copy-id (some #(when (= (:id dependent-child) (get-in % [:shape :shape-ref])) + (get-in % [:shape :id])) (cg/tree situation)) + edited (-> initial (cg/step [:library-edit source-index 0 1]) cg/settle-state) + dependent-accepted (-> edited (cg/step [:library-accept 0]) cg/settle-state) + accepted (-> dependent-accepted (cg/step [:library-sync 0]) cg/settle-state) + fill #(get-in (tm/shape-by-id (:situation %) copy-id) [:fills 0 :fill-color])] + (t/is (some? dependent-child)) + (t/is (some? copy-id)) + (t/is (= setup/labeled-fill (fill edited))) + (t/is (= setup/labeled-fill (fill dependent-accepted))) + (t/is (= "#ff0000" (fill accepted))) + (t/is (map? (cg/run {:world [2 0 {:library true :stale-libraries true :library-dependency true}] + :ops [[:library-edit source-index 0 1] [:library-accept 0] [:library-sync 0] + [:library-undo 0] [:library-redo 0] [:undo] [:redo]]}))))) + +(t/deftest a-local-cascade-keeps-an-unaccepted-swaps-library-inputs + (let [program {:world [2 1 {:library true :stale-libraries true :library-dependency true}] + :ops [[:swap 1] [:swap 18] [:library-add-child 16] [:edit 0 1 1 :copy-head]]} + result (cg/run program) + situation (:situation result) + head-at #(some (fn [{:keys [path shape]}] (when (= [2 0] path) shape)) (cg/tree %)) + head (head-at situation) + owner (:component-file head) + main-id (get-in (cf/all-files situation) [owner :data :components (:component-id head) :main-instance-id]) + main #(tm/shape-by-id (tm/with-file situation (get % owner)) main-id) + advanced (cf/remember-subtree situation (:id (tm/file situation)) (:id head) (cf/all-files situation))] + (t/is (= 1 (count (:shapes head)))) + (t/is (= 1 (count (:shapes (main (cf/reference-libraries situation head)))))) + (t/is (= 2 (count (:shapes (main (cf/all-files situation)))))) + (t/is (= :I4 (try (oracle/check advanced (:model result)) nil + (catch #?(:clj Exception :cljs js/Error) error (:invariant (ex-data error)))))) + (let [accepted (cg/run (update program :ops conj [:library-sync 1]))] + (t/is (= 2 (count (:shapes (head-at (:situation accepted))))))))) + +(t/deftest geometry-edits-cover-mains-copy-children-and-nested-copies + (doseq [action (range 6) scope (range 5)] + (let [result (cg/run {:world [2 2] + :ops [[:transform 0 action 3 scope] [:sync] [:undo] [:redo]]})] + (t/is (= 1 (get-in result [:coverage :random :transform :changed] 0)) + (str "geometry action " action ", scope " scope))))) + +(t/deftest hiding-a-grid-main-child-then-moving-its-main-stays-synced + (t/is (map? (cg/run {:world [2 1 {:text true :text-styles true :layout :grid}] + :ops [[:style 3 1 3 0] [:transform 0 0 0 0]]})))) + +(t/deftest showing-a-hidden-grid-main-child-assigns-it-a-cell-again + (let [result (cg/run {:world [2 1 {:text true :text-styles true :layout :grid}] + :ops [[:style 3 1 1 0] [:style 3 1 0 0]]}) + situation (:situation result) + shape (:shape (cg/resolve-op situation (:model result) [:style 3 1 0 0])) + parent (tm/shape-by-id situation (:parent-id shape))] + (t/is (false? (:hidden shape))) + (t/is (some #(some #{(:id shape)} (:shapes %)) (vals (:layout-grid-cells parent)))))) + +(t/deftest hiding-a-grid-copy-child-keeps-derived-cells-consistent + (t/is (map? (cg/run {:world [2 1 {:text true :text-styles true :layout :grid}] + :ops [[:style 6 1 3 0] [:transform 0 0 0 0] + [:undo] [:redo]]})))) + +(t/deftest applying-a-typography-after-a-swap-is-already-fully-synced + (t/is (map? (cg/run {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:swap 2] [:text-style 4 8 1] [:add-child 0] [:undo] [:undo] [:undo] [:redo] [:redo] [:redo]]})))) + +(t/deftest detaching-after-a-nested-switch-keeps-placement-stable-through-sync + (t/is (map? (cg/run {:world [2 2 {:library true :variants true :rich-variants true + :text true :text-styles true :layout :flex :layout-copies true}] + :ops [[:nest 7 0 0 0] [:switch 3 0 0 0] [:style 3 7 1] [:detach 6 0 0 0] + [:undo] [:undo] [:undo] [:undo] [:redo] [:redo] [:redo] [:redo]]})))) + +(t/deftest applying-typography-to-a-main-drops-a-mixed-copys-link-without-an-override + (t/is (map? (cg/run {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:swap 0 0 0 0] [:text 23 3 1 0] [:text-style 22 8 1] + [:undo] [:undo] [:undo] [:redo] [:redo] [:redo]]})))) + +(t/deftest typography-reference-oracle-rejects-wrong-retention-and-missing-inheritance + (doseq [mixed? [true false]] + (let [state (cond-> (cg/initial-state [2 0 {:text true :text-styles true}]) + mixed? (cg/step [:text 1 1 1])) + state (-> state (cg/step [:text-style 0 8 1]) (update :situation r/settle)) + situation (:situation state) + file (tm/file situation) + page (thf/current-page file) + copy (ths/get-shape file :copy-child) + content (-> (thtx/view (:content copy)) + (thtx/restyle :typography (when mixed? :generated-typography)) + thtx/content) + corrupted (tm/with-file situation + (assoc-in file [:data :pages-index (:id page) :objects (:id copy) :content] content))] + (t/is (nil? (oracle/check situation (:model state)))) + (t/is (= :I4 (try (oracle/check corrupted (:model state)) nil + (catch #?(:clj Exception :cljs js/Error) error (:invariant (ex-data error))))) + (if mixed? "mixed styles must lose the reference" "fully inherited styles must keep the reference"))))) + +(t/deftest detaching-a-rotated-switched-copy-keeps-nested-placement-stable + (doseq [angle (range 4)] + (t/is (map? (cg/run {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:duplicate 1 0 0 0] [:duplicate 1 0 0 0] [:switch 3 0 0 0] + [:rotate 5 0 0 angle] [:detach 5 0 0 0] + [:undo] [:undo] [:undo] [:undo] [:undo] + [:redo] [:redo] [:redo] [:redo] [:redo]]}))))) + +(t/deftest detaching-settles-new-placement-without-pulling-stale-content + (let [state (-> (reduce cg/step + (cg/initial-state [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}]) + [[:duplicate 1 0 0 0] [:duplicate 1 0 0 0] [:switch 3 0 0 0] [:rotate 5]]) + cg/settle-state) + situation (:situation state) + copy (:shape (first (filter #(= [:file 0 :page 0 5 0] (:path %)) (cg/forest situation)))) + near (tm/shape-by-id situation (:shape-ref copy)) + source-id (:shape-ref near) + stale (tm/with-file situation (ths/update-shape-by-id (tm/file situation) source-id :opacity 0.25)) + detached (r/step stale (:op (cg/resolve-op stale (:model state) [:detach 5]))) + head (tm/shape-by-id detached (:id copy)) + swapped (tm/shape-by-id detached (first (:shapes head)))] + (t/is (= 0.25 (:opacity (tm/shape-by-id detached source-id)))) + (t/is (= (:opacity copy) (:opacity head)) "detach must not accept the main's new content") + (t/is (= #{:swap-group} (:touched swapped)) "the placement correction stays inherited"))) + +(t/deftest applying-an-inherited-typography-authors-even-equal-units + (let [state (-> (cg/initial-state [2 0 {:text true :text-styles true}]) + (cg/step [:text-style 0 8 1]) cg/settle-state) + before (tm/shape-by-id (:situation state) (thi/id :copy-child)) + result (-> state (cg/step [:text-style 1 8 1]) cg/settle-state) + after (tm/shape-by-id (:situation result) (thi/id :copy-child)) + groups #{:content-group :text-content-typography :text-content-family + :text-content-weight :text-content-size :text-content-line-height + :text-content-spacing :text-content-case}] + (t/is (= (thtx/view (:content before)) (thtx/view (:content after)))) + (t/is (empty? (:touched before))) + (t/is (= groups (:touched after))) + (t/is (= groups (set (keys (get (:model result) (:id after)))))) + (let [undone (-> result (cg/step [:undo]) cg/settle-state)] + (t/is (= (oracle/snapshot (:situation state)) (oracle/snapshot (:situation undone))))) + (t/is (= 2 (get-in result [:coverage :random :text-style :changed] 0)) + "both the main's value edit and the copy's authorship count as mutations"))) + +(t/deftest deleted-variant-content-keeps-its-size-when-the-position-resizes + (t/is (map? (cg/run {:world [2 2 {:variants true :variant-diff false}] + :ops [[:switch 1] [:delete 0] [:restore 0] [:delete 1] + [:resize 0] [:undo] [:redo]]})))) + +(defn- translate-result + [situation id] + (let [file (tm/file situation) + page (thf/current-page file) + changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page)) [id] + #(gsh/move % (gpt/point 5 0)) (:objects page) + {:ignore-touched true})] + (tm/with-file situation (thf/apply-changes file changes)))) + +(t/deftest geometry-expectations-do-not-read-the-primary-result + (doseq [tuple [[:resize 0 0 1] [:rotate 0 0 1] [:transform 0 0 1 0]]] + (let [initial (cg/initial-state [2 1]) + original r/step + invariant (try + (with-redefs [r/step (fn [situation op] + (let [result (original situation op)] + (if (:target op) + (translate-result result (tm/target-shape-id situation (:target op))) + result)))] + (cg/step initial tuple)) + nil + (catch #?(:clj Exception :cljs js/Error) error + (select-keys (ex-data error) [:invariant :phase])))] + (t/is (= {:invariant :I9 :phase :requested-geometry} invariant))))) + +(t/deftest authored-child-position-follows-its-parent-and-rejects-drift + (let [initial (cg/initial-state [2 1]) + id (get-in (cg/resolve-op (:situation initial) {} [:transform 0 0 1 2]) [:shape :id]) + authored (-> initial (cg/step [:transform 0 0 1 2]) cg/settle-state) + moved (-> authored (cg/step [:transform 0 0 1 4]) cg/settle-state) + broken (translate-result (:situation moved) id)] + (t/is (nil? (oracle/check (:situation moved) (:model moved)))) + (t/is (= :I9 (try (oracle/check broken (:model moved) false) nil + (catch #?(:clj Exception :cljs js/Error) error (:invariant (ex-data error)))))))) + +(t/deftest pushed-authored-child-position-uses-the-main-frame + (t/is (map? (cg/run {:world [2 2 {:variants true :variant-diff false}] + :ops [[:transform 0 0 0 3] [:edit 1 0 1 1] [:update-main 1]]})))) + +(t/deftest accepting-an-upstream-library-after-its-dependent-was-refreshed + (t/is (map? (cg/run {:world [2 0 {:library true :stale-libraries true :library-dependency true}] + :ops [[:library-edit 3 0 1] [:library-accept 0] [:library-sync 1]]})))) + +(t/deftest detached-inherited-child-position-uses-the-copy-parent-frame + (t/is (map? (cg/run {:world [3 2 {:text true :layout nil}] + :ops [[:transform 1 0 0 2] [:nest 3] [:detach 2]]})))) + +(t/deftest reflecting-a-rotated-copy-settles-descendant-flips + (t/is (map? (cg/run {:world [2 1 {:text true :layout :grid}] + :ops [[:rotate 1] [:transform 2 16 0 9]]})))) + +(t/deftest swapping-after-a-resized-variant-keeps-child-placement + (t/is (map? (cg/run {:world [2 2 {:variants true :variant-diff false :rich-variants true + :text true :layout nil :layout-copies true}] + :ops [[:resize 0] [:switch 0] [:swap 0]]})))) + +(t/deftest switching-after-a-main-move-and-child-removal-stays-settled + (t/is (map? (cg/run {:world [2 0 {:library true :variants true :rich-variants true :text true + :layout :flex :layout-copies true}] + :ops [[:delete 0] [:restore 0] [:transform 4 0 0 0] [:remove-child 8] + [:style 5 7 0 0] [:switch 4] [:rotate 0 2 0 0]]})))) + +(t/deftest reflecting-a-rotated-nested-copy-settles-descendant-flips + (t/is (map? (cg/run {:world [2 1 {:text true :layout :grid}] + :ops [[:nest 11] [:rotate 1] [:transform 2 16 0 18]]})))) + +(t/deftest detach-keeps-an-authored-swap-inside-a-surviving-copy + (t/is (map? (cg/run {:world [2 2 {:variants true :variant-diff false}] + :ops [[:switch 10] [:switch 0] [:detach 2]]})))) + +(t/deftest reflecting-a-parent-keeps-an-authored-childs-relative-orientation + (t/is (map? (cg/run {:world [2 1] + :ops [[:transform 0 0 1 2] [:rotate 0] [:transform 0 4 0 4] + [:undo] [:redo]]})))) + +(t/deftest variant-worlds-contain-distinct-structure-size-text-and-properties + (let [situation (cg/world [2 2 {:variants true :rich-variants true :text true + :layout :grid :layout-copies true}]) + members (:members (n/variant-set situation "random-variants")) + roots (map #(tm/shape-by-id situation (thi/id (:root-label %))) members) + components (map #(get-in (tm/file situation) [:data :components (:component-id %)]) members)] + (t/is (= 4 (count members))) + (t/is (true? (every? #(= 3 (count (:variant-properties %))) components))) + (t/is (> (count (set (map (juxt :width :height) roots))) 1)) + (t/is (> (count (set (map (comp count :shapes) roots))) 1)) + (t/is (true? (every? (fn [root] (some #(= :text (:type (tm/shape-by-id situation %))) (:shapes root))) roots))) + (t/is (boolean (some #(and (:layout (:shape %)) + (some (fn [id] (:component-id (tm/shape-by-id situation id))) + (:shapes (:shape %)))) (cg/tree situation)))))) + +(t/deftest nearest-variant-prefers-earlier-properties-and-rejects-a-wrong-choice + (let [initial (cg/initial-state [2 2 {:variants true :rich-variants true}]) + situation (:situation initial) + file (tm/file situation) + members (:members (n/variant-set situation "random-variants")) + [a b _ d] (map #(get-in file [:data :components (:component-id %)]) members) + shape {:component-file (:id file) :component-id (:id a)} + items (cg/candidates situation {} :switch nil) + index (some (fn [[index entry]] + (when (and (= (:id a) (get-in entry [:shape :component-id])) + (= 0 (:variant-pos entry)) + (= (:id b) (get-in entry [:destination :shape :component-id]))) index)) + (map-indexed vector items))] + (t/is (= (:id b) (:id (variants/nearest file shape 0 "Large")))) + (t/is (some? index)) + (t/is (= {:invariant :I9 :phase :requested-component} + (try (with-redefs [clv/find-switch-target (constantly d)] + (cg/step initial [:switch index])) + nil + (catch #?(:clj Exception :cljs js/Error) error + (select-keys (ex-data error) [:invariant :phase]))))))) + +(t/deftest switch-shadow-carries-compatible-text-style-units + (doseq [[new-size carry?] [[14 true] [22 false]]] + (let [content #(thtx/content [[["Same text" {:size %}]]]) + root {:type :frame :name "Board" :width 100 :height 100 :rotation 0} + old-main (assoc root :id :old :shapes [:old-text]) + new-main (assoc root :id :new :shapes [:new-text]) + text {:type :text :name "Caption" :width 70 :height 25 :rotation 0} + before {:old old-main :old-text (assoc text :id :old-text :parent-id :old :content (content 14)) + :copy (assoc root :id :copy :shape-ref :old :shapes [:copy-text]) + :copy-text (assoc text :id :copy-text :shape-ref :old-text :parent-id :copy :content (content 18))} + after {:new new-main :new-text (assoc text :id :new-text :parent-id :new :content (content new-size)) + :copy (assoc root :id :copy :shape-ref :new :shapes [:result-text]) + :result-text (assoc text :id :result-text :shape-ref :new-text :parent-id :copy :content (content new-size))} + model {:copy-text {:content-group {} :text-content-size {:content (content 18)}}} + result (shadow/swap model before after :copy :old :new true) + expected (get-in result [:result-text :text-content-size])] + (t/is (= carry? (some? expected))) + (when carry? + (t/is (= {} (get-in result [:result-text :content-group]))) + (t/is (false? (shadow/same-value? (:result-text after) :text-content-size expected))))))) + +(t/deftest source-library-edits-wait-for-explicit-consumer-acceptance + (let [initial (cg/initial-state [2 1 {:library true :stale-libraries true}]) + situation (:situation initial) + library (first (vals (tm/aux-files situation))) + source (:shape (first (filter #(and (= :rect (get-in % [:shape :type])) + (nil? (get-in % [:shape :shape-ref]))) + (cg/tree (tm/with-file situation library))))) + copies (filter #(= (:id source) (get-in % [:shape :shape-ref])) (cg/tree situation)) + copy-id (get-in (first copies) [:shape :id]) + edited (-> initial (cg/step [:library-edit 0 0 1]) cg/settle-state) + source-after (get-in (cf/all-files (:situation edited)) + [(:id library) :data :pages-index (first (get-in library [:data :pages])) + :objects (:id source)]) + accepted (-> edited (cg/step [:library-sync]) cg/settle-state) + undone (-> accepted (cg/step [:undo]) cg/settle-state) + redone (-> undone (cg/step [:redo]) cg/settle-state) + fill #(get-in (tm/shape-by-id (:situation %) copy-id) [:fills 0 :fill-color])] + (t/is (seq copies)) + (t/is (= "#ff0000" (get-in source-after [:fills 0 :fill-color]))) + (t/is (= (get (oracle/snapshot situation) (:id (tm/file situation))) + (get (oracle/snapshot (:situation edited)) (:id (tm/file situation))))) + (t/is (= setup/labeled-fill (fill edited))) + (t/is (= "#ff0000" (fill accepted))) + (t/is (= setup/labeled-fill (fill undone))) + (t/is (= "#ff0000" (fill redone))) + (t/is (= 1 (get-in accepted [:coverage :random :library-sync :changed]))))) + +(t/deftest independent-source-edits-and-acceptance-have-cross-file-inverses + (let [result (cg/run {:world [2 1 {:library true :stale-libraries true}] + :ops [[:library-edit 0 0 1] [:library-undo] [:library-redo] + [:library-sync] [:undo] [:redo]]})] + (t/is (= 1 (get-in result [:coverage :random :library-edit :changed]))) + (t/is (= 1 (get-in result [:coverage :random :library-sync :changed]))) + (t/is (= 1 (count (tm/aux-files (:situation result))))))) + +(t/deftest stale-copy-edits-survive-acceptance-and-reset-uses-the-loaded-main + (let [spec [2 1 {:library true :stale-libraries true}] + initial (cg/initial-state spec) + situation (:situation initial) + library-id (first (keys (tm/aux-files situation))) + candidates (cg/candidates situation {} :edit 2) + [index entry] (first (keep-indexed (fn [index entry] + (when (= :rect (get-in entry [:shape :type])) [index entry])) + candidates)) + id (get-in entry [:shape :id]) + parent (get-in entry [:shape :parent-id]) + reset-index (first (keep-indexed #(when (= parent (get-in %2 [:shape :id])) %1) + (cg/candidates situation {} :reset nil))) + edited (-> initial (cg/step [:library-edit 0 0 1]) + (cg/step [:edit index 0 2 2]) cg/settle-state) + accepted (-> edited (cg/step [:library-sync]) cg/settle-state) + reset (-> edited (cg/step [:reset reset-index]) cg/settle-state) + reset-accepted (-> reset (cg/step [:library-sync]) cg/settle-state) + fill #(get-in (tm/shape-by-id (:situation %) id) [:fills 0 :fill-color])] + (t/is (some? library-id)) + (t/is (some? reset-index)) + (t/is (= "#00ff00" (fill accepted))) + (t/is (= #{:fill-group} (set (:touched (tm/shape-by-id (:situation accepted) id))))) + (t/is (= "#ff0000" (fill reset))) + (t/is (= "#ff0000" (fill reset-accepted))) + (t/is (map? (cg/run {:world spec + :ops [[:library-edit 0 0 1] [:edit index 0 2 2] + [:reset reset-index] [:library-sync] [:undo] [:redo]]}))))) + +(t/deftest stale-copy-can-swap-before-accepting-the-library-update + (let [spec [2 1 {:library true :stale-libraries true}] + initial (cg/initial-state spec) + situation (:situation initial) + library-id (first (keys (tm/aux-files situation))) + index (first (keep-indexed #(when (= library-id (get-in %2 [:shape :component-file])) %1) + (cg/candidates situation {} :swap nil))) + result (cg/run {:world spec + :ops [[:library-edit 0 0 1] [:swap index] + [:library-sync] [:undo] [:redo]]})] + (t/is (some? index)) + (t/is (= 1 (get-in result [:coverage :random :swap :changed]))) + (t/is (= 1 (get-in result [:coverage :random :library-sync :changed]))))) + +(t/deftest pushing-a-local-override-does-not-accept-unrelated-source-edits + (let [spec [2 1 {:library true :stale-libraries true :library-variants true}] + initial (cg/initial-state spec) + situation (:situation initial) + {:keys [shape library-id]} (cg/resolve-op situation {} [:library-edit 1 0 1]) + copy-id (some #(when (= (:id shape) (get-in % [:shape :shape-ref])) + (get-in % [:shape :id])) (cg/tree situation)) + pushed (-> initial (cg/step [:library-edit 1 0 1]) + (cg/step [:edit 0 1 1 2]) (cg/step [:update-main 0]) cg/settle-state) + after (:situation pushed) + source (tm/with-file after (get (tm/aux-files after) library-id)) + reference (get (cf/reference-libraries after (:id (tm/file after)) copy-id) library-id)] + (t/is (some? copy-id)) + (t/is (= setup/labeled-fill (get-in (tm/shape-by-id after copy-id) [:fills 0 :fill-color]))) + (t/is (= setup/labeled-fill + (get-in (tm/shape-by-id (tm/with-file after reference) (:id shape)) [:fills 0 :fill-color]))) + (t/is (= "#ff0000" (get-in (tm/shape-by-id source (:id shape)) [:fills 0 :fill-color]))) + (t/is (= 1 (get-in pushed [:coverage :random :update-main :changed]))))) + +(t/deftest source-history-does-not-undo-consumer-edits + (t/is (map? (cg/run {:world [2 1 {:library true :stale-libraries true}] + :ops [[:library-edit 0 0 1] [:edit 0 1 1 2] + [:library-sync] [:library-undo] [:library-redo] + [:undo] [:undo] [:redo] [:redo]]})))) + +(t/deftest no-op-acceptance-does-not-rewrite-an-earlier-edits-undo-baseline + (t/is (map? (cg/run {:world [2 0 {:library true :stale-libraries true}] + :ops [[:edit 1 0 2 2] [:library-edit 0 0 1] + [:library-sync] [:undo] [:undo] [:redo] [:redo]]})))) + +(t/deftest coverage-distinguishes-random-changes-no-ops-and-skips + (let [result (cg/run {:world [2 0] + :ops [[:edit 0 0 1 1] [:edit 0 0 1 1] + [:restore 0] [:sync 0]]})] + (t/is (= {:attempted 2 :eligible 2 :changed 1 :no-op 1} + (select-keys (get-in result [:coverage :random :edit]) + [:attempted :eligible :changed :no-op]))) + (t/is (= {:attempted 1 :eligible 0 :skipped 1} + (select-keys (get-in result [:coverage :random :restore]) + [:attempted :eligible :skipped]))) + (t/is (= 1 (get-in result [:coverage :random :sync :no-op]))))) + +(t/deftest setup-does-not-count-as-random-mutation-coverage + (let [result (cg/run {:world [2 0] + :prefix [[:edit 0 0 1 1]] + :ops [[:restore 0] [:sync 0]]})] + (t/is (= 1 (get-in result [:coverage :setup :edit :changed]))) + (t/is (nil? (get-in result [:coverage :random :edit]))) + (t/is (= 1 (get-in result [:coverage :random :restore :skipped]))))) + +(t/deftest coverage-rejects-vacuous-random-tails-and-underrepresented-kinds + (doseq [counts [{:attempted 100 :eligible 0 :skipped 100} + {:attempted 100 :eligible 100 :no-op 100}]] + (t/is (seq (cg/coverage-errors {:setup {:edit {:changed 100}} + :random {:edit counts}} + [:edit])))) + (t/is (seq (cg/coverage-errors {:random {:edit {:attempted 1000 :changed 1000} + :reset {:attempted 1000 :changed 1 :no-op 999}}} + [:edit :reset]))) + (t/is (empty? (cg/coverage-errors {:random {:edit {:attempted 10 :changed 10} + :sync {:attempted 10 :no-op 10}}} + [:edit :sync])))) + (t/deftest oracle-rejects-phantom-and-missing-overrides (let [situation (setup/simple-component-with-labeled-copy) shape (tm/resolve-shape situation :copy-child) @@ -89,9 +598,9 @@ (smt/for [program cg/program-gen] (cg/check-program program coverage failure)) :max-size 30) - (println "Executed component operations:" (pr-str @coverage)) - (doseq [kind [:edit :reset :update-main :detach :sync :undo :redo]] - (t/is (pos? (get @coverage kind 0)) (str "No executed " kind))))) + (println "Component operation coverage:" (pr-str @coverage)) + (t/is (empty? (cg/coverage-errors @coverage [:edit :reset :update-main :detach :sync :undo :redo])) + (pr-str (cg/coverage-errors @coverage [:edit :reset :update-main :detach :sync :undo :redo]))))) (t/deftest random-structure-compositions (let [coverage (atom {}) @@ -100,9 +609,9 @@ (smt/for [program cg/structure-program-gen] (cg/check-program program coverage failure)) :max-size 30) - (println "Executed structure operations:" (pr-str @coverage)) - (doseq [kind cg/structure-kinds] - (t/is (pos? (get @coverage kind 0)) (str "No executed " kind))))) + (println "Structure operation coverage:" (pr-str @coverage)) + (t/is (empty? (cg/coverage-errors @coverage cg/structure-kinds)) + (pr-str (cg/coverage-errors @coverage cg/structure-kinds))))) (t/deftest partial-sync-keeps-independent-components-pending (let [situation (cg/world [3 0]) @@ -149,9 +658,9 @@ (smt/for [program cg/swap-program-gen] (cg/check-program program coverage failure)) :max-size 30) - (println "Executed swap operations:" (pr-str @coverage)) - (doseq [kind [:swap :switch :edit :reset :undo :redo]] - (t/is (pos? (get @coverage kind 0)) (str "No executed " kind))))) + (println "Swap operation coverage:" (pr-str @coverage)) + (t/is (empty? (cg/coverage-errors @coverage cg/swap-kinds)) + (pr-str (cg/coverage-errors @coverage cg/swap-kinds))))) (t/deftest random-renames-leave-variant-management-to-its-own-operations (let [situation (cg/world [2 2 {:variants true}]) @@ -188,9 +697,31 @@ (smt/for [program cg/library-program-gen] (cg/check-program program coverage failure)) :max-size 30) - (println "Executed library operations:" (pr-str @coverage)) - (doseq [kind [:edit :update-main :library-sync :undo :redo]] - (t/is (pos? (get @coverage kind 0)) (str "No executed " kind))))) + (println "Library operation coverage:" (pr-str @coverage)) + (t/is (empty? (cg/coverage-errors @coverage cg/library-kinds)) + (pr-str (cg/coverage-errors @coverage cg/library-kinds))))) + +(t/deftest random-stale-library-compositions + (let [coverage (atom {}) + failure (atom nil)] + (smt/check! + (smt/for [program cg/stale-library-program-gen] + (cg/check-program program coverage failure)) + :max-size 30) + (println "Stale library operation coverage:" (pr-str @coverage)) + (t/is (empty? (cg/coverage-errors @coverage cg/stale-library-kinds #{:sync})) + (pr-str (cg/coverage-errors @coverage cg/stale-library-kinds #{:sync}))))) + +(t/deftest random-library-dependency-compositions + (let [coverage (atom {}) + failure (atom nil)] + (smt/check! + (smt/for [program cg/dependency-program-gen] + (cg/check-program program coverage failure)) + :max-size 30) + (println "Library dependency operation coverage:" (pr-str @coverage)) + (t/is (empty? (cg/coverage-errors @coverage cg/dependency-kinds #{:sync})) + (pr-str (cg/coverage-errors @coverage cg/dependency-kinds #{:sync}))))) (t/deftest update-main-moves-an-authored-swap-to-the-replaced-main-shape (let [result (cg/run {:world [2 1 {:library true :variants true}] diff --git a/common/test/common_tests/logic/composable_oracle_test.cljc b/common/test/common_tests/logic/composable_oracle_test.cljc index 30751fd5ff..e3de45a5bf 100644 --- a/common/test/common_tests/logic/composable_oracle_test.cljc +++ b/common/test/common_tests/logic/composable_oracle_test.cljc @@ -7,6 +7,7 @@ (ns common-tests.logic.composable-oracle-test (:require [app.common.files.changes-builder :as pcb] + [app.common.files.helpers :as cfh] [app.common.geom.matrix :as gmt] [app.common.geom.modifiers :as gm] [app.common.geom.point :as gpt] @@ -25,11 +26,110 @@ [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] + [app.common.types.component :as ctk] [app.common.types.modifiers :as ctm] [clojure.test :as t])) (t/use-fixtures :each thi/test-fixture) +(t/deftest oracle-attribute-inventory-covers-every-sync-attribute-and-group + (let [specified (into #{} + (mapcat (fn [[group attrs]] (map #(vector % group) attrs))) + (merge-with into shadow/attributes shadow/specialized-attributes)) + production (into #{} + (mapcat (fn [[attr group]] + (map #(vector attr %) (if (map? group) (vals group) [group])))) + ctk/sync-attrs)] + (t/is (= production specified)))) + +(t/deftest sync-equivalence-retains-nested-copy-head-placement + (let [initial (setup/nested-component-with-copy) + file (tm/file initial) + page (thf/current-page file) + id (:id (tm/role-shape initial :copy-instance)) + changed (thf/apply-changes file + (cls/generate-update-shapes + (pcb/empty-changes nil (:id page)) + (cons id (cfh/get-children-ids (:objects page) id)) + #(gsh/move % (gpt/point 5 0)) + (:objects page) {:ignore-touched true}))] + (t/is (not (oracle/equivalent? (oracle/canonical initial) + (oracle/canonical (tm/with-file initial changed))))))) + +(t/deftest design-comparison-uses-the-false-default-for-fixed-scroll + (let [initial (setup/simple-component-with-labeled-copy) + with-value #(tm/with-file initial (-> (tm/file initial) + (ths/update-shape :copy-root :fixed-scroll %) + (ths/update-shape :copy-root :touched nil))) + disabled (with-value false) + enabled (with-value true) + touched (tm/with-file disabled (ths/update-shape (tm/file disabled) :copy-root :touched #{:constraints-group}))] + (t/is (oracle/equivalent? (oracle/canonical initial) (oracle/canonical disabled))) + (t/is (not (oracle/equivalent? (oracle/canonical initial) (oracle/canonical enabled)))) + (t/is (not (oracle/equivalent? (oracle/canonical disabled) (oracle/canonical touched)))) + (t/is (not= (oracle/snapshot initial) (oracle/snapshot disabled))) + (t/is (nil? (oracle/check disabled {}))) + (t/is (= :I4 (try (oracle/check enabled {}) nil + (catch #?(:clj Exception :cljs js/Error) error (:invariant (ex-data error)))))))) + +(t/deftest backend-parity-follows-a-free-head-without-hiding-copy-drift + (let [initial (setup/nested-component-with-copy) + file (tm/file initial) + page (thf/current-page file) + objects (:objects page) + source (tm/resolve-shape initial :main2-nested-head) + copy (tm/role-shape initial :copy-instance) + move (fn [heads] + (tm/with-file initial + (thf/apply-changes + file (cls/generate-update-shapes + (pcb/empty-changes nil (:id page)) + (mapcat #(cfh/get-children-ids-with-self objects (:id %)) heads) + #(gsh/move % (gpt/point 30 0)) objects {:ignore-touched true})))) + inherited (move [source copy]) + drifted (move [copy]) + parity {:relative-free-head-placement true} + strict {:free-head-placement false}] + (t/is (oracle/equivalent? (oracle/canonical initial parity) (oracle/canonical inherited parity))) + (t/is (not (oracle/equivalent? (oracle/canonical initial parity) (oracle/canonical drifted parity)))) + (t/is (not (oracle/equivalent? (oracle/canonical initial strict) (oracle/canonical inherited strict)))) + (t/is (not (oracle/equivalent? (oracle/canonical initial) (oracle/canonical inherited)))))) + +(t/deftest oracle-rejects-unmarked-differences-in-all-scalar-groups + (let [situation (setup/simple-component-with-labeled-copy) + file (tm/file situation)] + (doseq [[attr value] [[:hidden true] [:blocked true] [:r1 8] + [:strokes [{:stroke-color "#ff0000" :stroke-opacity 1 + :stroke-width 2 :stroke-style :solid + :stroke-alignment :center}]] + [:shadow [{:id (thi/new-id! :shadow) :style :drop-shadow + :color {:color "#000000" :opacity 0.5} + :offset-x 2 :offset-y 2 :blur 4 :spread 0 + :hidden false}]] + [:blur {:id (thi/new-id! :blur) :type :layer-blur :value 4 :hidden false}] + [:show-content true]]] + (t/testing (str attr) + (let [target (if (= attr :show-content) :copy-root :copy-child) + broken (-> file + (ths/update-shape target attr value) + (ths/update-shape target :touched nil))] + (t/is (= :I4 (try + (oracle/check (tm/with-file situation broken) {}) + nil + (catch #?(:clj Exception :cljs js/Error) error + (:invariant (ex-data error))))))))))) + +(t/deftest oracle-rejects-touched-on-mains-and-detached-shapes + (let [initial (setup/simple-component-with-labeled-copy) + detached (-> initial (r/step (n/detach :copy-root)) r/settle)] + (doseq [[situation label] [[initial :main-child] [detached :copy-child]]] + (let [file (tm/file situation) + page-id (:id (thf/current-page file)) + broken (assoc-in file [:data :pages-index page-id :objects (thi/id label) :touched] + #{:fill-group})] + (t/is (thrown? #?(:clj Exception :cljs js/Error) + (oracle/check (tm/with-file situation broken) {} false))))))) + (t/deftest sync-equivalence-compares-geometry-without-rounding-boundaries (let [initial (setup/simple-component-with-labeled-copy) file (ths/update-shape (tm/file initial) :copy-child :opacity 0.4) @@ -152,6 +252,41 @@ (t/is (thrown? #?(:clj Exception :cljs js/Error) (oracle/check (tm/make-situation file) {}))))) +(t/deftest grid-visibility-expectations-still-reject-cell-corruption + (let [file (-> (thf/sample-file :file1) + (tho/add-frame :main-root (merge cls/initial-grid-layout {:width 300 :height 100})) + (tho/add-rect :main-first {:parent-label :main-root}) + (tho/add-rect :main-second {:parent-label :main-root}) + (tho/add-rect :main-third {:parent-label :main-root}) + (tho/place-in-grid-columns :main-root 3 {1 :main-first 2 :main-second 3 :main-third}) + (thc/make-component :component1 :main-root) + (thc/instantiate-component :component1 :copy-root + :children-labels [:copy-first :copy-second :copy-third])) + initial (tm/make-situation file) + page-id (:id (thf/current-page file)) + first-child (ths/get-shape file :copy-first) + hidden (r/step initial (n/change-property :copy-first :hidden true)) + model (shadow/edit {} first-child :hidden true) + cells-path [:data :pages-index page-id :objects (thi/id :copy-root) :layout-grid-cells] + cells (vals (get-in (tm/file hidden) cells-path)) + occupied (first (filter (comp seq :shapes) cells)) + empty-cell (first (remove (comp seq :shapes) cells)) + corrupt (fn [cell f] + (tm/with-file hidden + (update-in (tm/file hidden) (conj cells-path (:id cell)) f))) + invariant (fn [situation] + (try (oracle/check situation model) nil + (catch #?(:clj Exception :cljs js/Error) error + (select-keys (ex-data error) [:invariant :group]))))] + (t/is (nil? (oracle/check hidden model))) + (doseq [[cell f] [[empty-cell #(assoc % :shapes [(thi/id :copy-first)])] + [occupied #(assoc % :shapes [])] + [occupied #(update % :column inc)] + [occupied #(update % :column-span inc)] + [occupied #(assoc % :position :auto)]]] + (t/is (= {:invariant :I4 :group :layout-grid-cells} + (invariant (corrupt cell f))))))) + (t/deftest oracle-accepts-layout-owned-fill-sizing (doseq [layout [:flex :grid]] (let [file (-> (thf/sample-file :file1) @@ -274,6 +409,34 @@ (t/is (= equal? (oracle/equivalent? (oracle/canonical (tm/make-situation file)) (oracle/canonical (tm/make-situation changed)))))))) +(t/deftest matrix-comparison-does-not-reintroduce-derived-text-dimensions + (doseq [grow-type [:auto-height :auto-width]] + (let [file (-> (thf/sample-file :file) + (ths/add-sample-shape :text :type :text :grow-type grow-type + :width 70 :height 25)) + page-id (:id (thf/current-page file)) + path [:data :pages-index page-id :objects (thi/id :text)] + measured (update-in file path + #(gsh/transform-shape % (ctm/change-size % + (if (= grow-type :auto-width) 55 70) + 17))) + changed (assoc-in measured (conj path :transform) (gmt/matrix 1 0 0 1 2 0)) + stretched (assoc-in measured (conj path :transform) (gmt/matrix 1 0 0 1.1 0 0)) + fixed-width (assoc-in measured (conj path :width) 60) + turn #(gsh/absolute-move (gsh/transform-shape % (n/geometry-modifiers % :rotate 45)) + (gpt/point 0 0)) + rotated (update-in file path turn) + rotated-measured (update-in measured path turn) + design #(oracle/canonical (tm/make-situation %))] + (t/is (oracle/equivalent? (design file) (design measured))) + (t/is (oracle/equivalent? (design rotated) (design rotated-measured))) + (t/is (not (oracle/equivalent? (design file) (design changed)))) + (t/is (not (oracle/equivalent? (design file) (design stretched)))) + (t/is (not= (oracle/snapshot (tm/make-situation file)) + (oracle/snapshot (tm/make-situation measured)))) + (when (= grow-type :auto-height) + (t/is (not (oracle/equivalent? (design file) (design fixed-width)))))))) + (t/deftest authored-child-orientation-follows-the-parent-frame (let [model {:child {:geometry-group {:width 20 :height 30 :rotation 90}}} before {:child {:id :child :parent-id :parent} diff --git a/common/test/common_tests/logic/swap_group_test.cljc b/common/test/common_tests/logic/swap_group_test.cljc index 3ee293298f..b6709425f9 100644 --- a/common/test/common_tests/logic/swap_group_test.cljc +++ b/common/test/common_tests/logic/swap_group_test.cljc @@ -164,6 +164,27 @@ (thf/validate-file!))] (t/is (= :right (:constraints-h (ths/get-shape file :copy-star)))))) +(t/deftest swapped-head-content-sync-keeps-the-replaced-childs-placement + (let [file (-> (setup) + (ths/update-shape :card-star :constraints-h :right) + (ths/update-shape :card-star :constraints-v :bottom) + (ths/update-shape :card-star :fixed-scroll true) + (ths/update-shape :heart-main :constraints-h :scale) + (ths/update-shape :heart-main :constraints-v :scale) + (ths/update-shape :heart-main :fixed-scroll false) + (ths/update-shape :heart-main :opacity 0.4) + (propagate :card)) + placement #(select-keys (ths/get-shape % :copy-star) + [:constraints-h :constraints-v :fixed-scroll]) + expected {:constraints-h :right :constraints-v :bottom :fixed-scroll true} + synced (-> file (propagate :heart) thf/validate-file!) + reversed (-> file (propagate :heart :card) thf/validate-file!)] + (t/is (= expected (placement file))) + (t/is (= expected (placement synced))) + (t/is (= (placement synced) (placement reversed))) + (t/is (= 0.4 (:opacity (ths/get-shape synced :copy-star)))) + (t/is (= #{:swap-group} (:touched (ths/get-shape synced :copy-star)))))) + (t/deftest moved-swapped-head-keeps-its-position (let [file (-> (setup) (move-shape :copy-star 5 5)) @@ -306,6 +327,29 @@ (propagate :heart) (tho/bottom-fill-color :copy-star)))))) +(t/deftest detach-keeps-a-swapped-heads-inherited-placement-as-overrides + (let [initial (-> (setup) + (ths/update-shape :card-star :constraints-h :right) + (ths/update-shape :card-star :fixed-scroll true) + (propagate :card)) + detached (detach initial :copy) + synced (-> detached (propagate :heart) thf/validate-file!) + head (ths/get-shape synced :copy-star)] + (t/is (= :right (:constraints-h head))) + (t/is (true? (:fixed-scroll head))) + (t/is (= #{:constraints-group} (:touched (ths/get-shape detached :copy-star)))) + (t/is (= (:touched (ths/get-shape detached :copy-star)) (:touched head))))) + +(t/deftest copied-swapped-head-keeps-its-placement-ownership + (let [initial (-> (setup) + (ths/update-shape :card-star :fixed-scroll true) + (propagate :card)) + objects (copy-objects initial :copy-star) + head (get objects (thi/id :copy-star))] + (t/is (true? (:fixed-scroll head))) + (t/is (= (thi/id :heart-main) (:shape-ref head))) + (t/is (= #{:constraints-group} (:touched head))))) + (t/deftest detach-advances-a-deeper-swapped-head-by-position (let [file (setup-two-levels) dot (first-child file :outer-star) diff --git a/frontend/src/app/main/data/workspace/libraries.cljs b/frontend/src/app/main/data/workspace/libraries.cljs index 1a2d70e01e..f8f1e74feb 100644 --- a/frontend/src/app/main/data/workspace/libraries.cljs +++ b/frontend/src/app/main/data/workspace/libraries.cljs @@ -995,7 +995,8 @@ ldata (dsh/lookup-file-data state file-id) undo-id (js/Symbol) - undo-group (uuid/next) + undo-group (or (get-in state [:workspace-undo :transaction :undo-group]) + (uuid/next)) [new-shape changes update-layout-ids] (-> (pcb/empty-changes it (:id page)) @@ -1020,7 +1021,8 @@ (dwtp/propagate-workspace-tokens) ;; Make the new instance get the token values from the current file, not from the component's library (when (and (features/active-feature? state "render-wasm/v1") (seq new-text-ids)) - (dwwt/resize-wasm-text-all new-text-ids {:skip-component-sync? true})) + (dwwt/resize-wasm-text-all new-text-ids {:skip-component-sync? true + :undo-group undo-group})) (ptk/data-event :layout/update {:ids update-layout-ids :undo-group undo-group}) (dwu/commit-undo-transaction undo-id) (dws/select-shape (:id new-shape) false)))))) diff --git a/frontend/src/app/main/data/workspace/texts.cljs b/frontend/src/app/main/data/workspace/texts.cljs index 49c3039d3c..ca9d0b0f88 100644 --- a/frontend/src/app/main/data/workspace/texts.cljs +++ b/frontend/src/app/main/data/workspace/texts.cljs @@ -16,6 +16,7 @@ [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] + [app.common.logic.shapes :as cls] [app.common.math :as mth] [app.common.render-wasm.api.select :as wselect] [app.common.transit :as t] @@ -129,8 +130,8 @@ (defn- await-font-faces "Waits for missing WASM faces, then resizes the affected texts." - [stream face-keys ids] - (let [resize-opts {:stack-undo? true :undo-transation? false} + [stream face-keys ids & [opts]] + (let [resize-opts (merge {:stack-undo? true :undo-transation? false} opts) resize-stream (->> (rx/from ids) (rx/map #(dwwt/resize-wasm-text % resize-opts)))] (if (empty? face-keys) resize-stream @@ -160,13 +161,13 @@ (defn- await-font-resize "Waits for missing font faces, then resizes `ids`." - [stream ids] + [stream ids opts] (if (empty? ids) (rx/empty) (->> (rx/of ::await-fonts) (rx/mapcat (fn [_] - (await-font-faces stream (pending-font-faces ids) ids)))))) + (await-font-faces stream (pending-font-faces ids) ids opts)))))) (defn- await-html-font "Keeps legacy DOM text pending while its new font is loading. The DOM @@ -607,7 +608,7 @@ (rx/empty))))))) (defn update-root-attrs - [{:keys [id attrs]}] + [{:keys [id attrs undo-group]}] (ptk/reify ::update-root-attrs ptk/WatchEvent (watch [_ state _] @@ -631,10 +632,10 @@ (cond (cfh/text-shape? shape) [id] (cfh/group-shape? shape) (cfh/get-children-ids objects id))] - (rx/of (dwsh/update-shapes shape-ids update-fn)))))) + (rx/of (dwsh/update-shapes shape-ids update-fn {:undo-group undo-group})))))) (defn update-paragraph-attrs - [{:keys [id attrs]}] + [{:keys [id attrs undo-group]}] (let [attrs (d/without-nils attrs)] (ptk/reify ::update-paragraph-attrs ptk/UpdateEvent @@ -658,10 +659,10 @@ (cfh/text-shape? shape) [id] (cfh/group-shape? shape) (cfh/get-children-ids objects id))] - (rx/of (dwsh/update-shapes shape-ids update-fn)))))))) + (rx/of (dwsh/update-shapes shape-ids update-fn {:undo-group undo-group})))))))) (defn update-text-attrs - [{:keys [id attrs]}] + [{:keys [id attrs typography? undo-group]}] (ptk/reify ::update-text-attrs ptk/UpdateEvent (update [_ state] @@ -669,7 +670,9 @@ ptk/WatchEvent (watch [_ state _] - (when-not (some? (get-in state [:workspace-editor-state id])) + (if (some? (get-in state [:workspace-editor-state id])) + (when typography? + (rx/of (dwsh/update-shapes [id] cls/touch-text-typography {:undo-group undo-group}))) (let [objects (dsh/lookup-page-objects state) shape (get objects id) wasm? (features/active-feature? state "render-wasm/v1") @@ -684,11 +687,12 @@ ;; `shape-text-contents` and overwrite per-run fills (e.g. line-height). merge-shape (fn [sh] - (let [updated-shape (txt/update-text-content sh update-node? d/txt-merge attrs)] + (let [updated-shape (cond-> (txt/update-text-content sh update-node? d/txt-merge attrs) + typography? cls/touch-text-typography)] (when wasm? (wasm.text-editor/cache-shape-text-content! (:id updated-shape) (:content updated-shape))) updated-shape))] - (rx/of (dwsh/update-shapes shape-ids merge-shape))))))) + (rx/of (dwsh/update-shapes shape-ids merge-shape {:undo-group undo-group}))))))) (defn migrate-node [node] @@ -1066,11 +1070,13 @@ (rx/empty)))))) (defn update-attrs - [id attrs] + [id attrs & {:keys [undo-group]}] (ptk/reify ::update-attrs ptk/WatchEvent (watch [_ state stream] - (let [text-editor-instance (:workspace-editor state) + (let [undo-group (or undo-group (get-in state [:workspace-undo :transaction :undo-group]) (uuid/next)) + resize-opts {:undo-group undo-group} + text-editor-instance (:workspace-editor state) objects (dsh/lookup-page-objects state) text-ids (resolve-text-ids objects id) @@ -1086,7 +1092,7 @@ (rx/concat (let [attrs (select-keys attrs txt/root-attrs)] (if-not (empty? attrs) - (rx/of (update-root-attrs {:id id :attrs attrs})) + (rx/of (update-root-attrs {:id id :attrs attrs :undo-group undo-group})) (rx/empty))) ;; `:line-height` is stored on both the paragraph and its spans, and @@ -1107,7 +1113,7 @@ :update-name? true)) :else - (rx/of (update-paragraph-attrs {:id id :attrs attrs})))) + (rx/of (update-paragraph-attrs {:id id :attrs attrs :undo-group undo-group})))) (let [attrs (select-keys attrs txt/text-node-attrs)] (cond @@ -1122,7 +1128,7 @@ (rx/of (dwt-v3/v3-update-text-editor-styles id attrs))) :else - (rx/of (update-text-attrs {:id id :attrs attrs})))) + (rx/of (update-text-attrs {:id id :attrs attrs :undo-group undo-group})))) (when (and (features/active-feature? state "text-editor/v2") (not (features/active-feature? state "text-editor-wasm/v1"))) @@ -1145,10 +1151,10 @@ (let [auto-ids (into [] (remove #(= :fixed (:grow-type (get objects %)))) text-ids)] (if (contains? attrs :font-id) ;; The geometry depends on the font, so wait until wasm has it. - (await-font-resize stream auto-ids) + (await-font-resize stream auto-ids resize-opts) ;; No font change: measurable right away. (->> (rx/from auto-ids) - (rx/map dwwt/resize-wasm-text))))) + (rx/map #(dwwt/resize-wasm-text % resize-opts)))))) ;; The legacy renderer re-measures these in the DOM on its own, ;; but font loading starts before that render commits. @@ -1176,12 +1182,13 @@ [ids attrs] (ptk/reify ::update-all-attrs ptk/WatchEvent - (watch [_ _ _] - (let [undo-id (js/Symbol)] + (watch [_ state _] + (let [undo-id (js/Symbol) + undo-group (or (get-in state [:workspace-undo :transaction :undo-group]) (uuid/next))] (rx/concat (rx/of (dwu/start-undo-transaction undo-id)) (->> (rx/from ids) - (rx/map #(update-attrs % attrs))) + (rx/map #(update-attrs % attrs :undo-group undo-group))) (rx/of (dwu/commit-undo-transaction undo-id))))))) (defn apply-typography @@ -1197,10 +1204,9 @@ (watch [_ state _] (let [editor-state (:workspace-editor-state state) ids (d/nilv ids (dsh/lookup-selected state)) - attrs (-> typography + attrs (-> (select-keys typography txt/typography-fields) (assoc :typography-ref-file file-id) - (assoc :typography-ref-id (:id typography)) - (dissoc :id :name)) + (assoc :typography-ref-id (:id typography))) undo-id (js/Symbol)] (rx/concat @@ -1208,7 +1214,7 @@ (->> (rx/from (seq ids)) (rx/map (fn [id] (let [editor (get editor-state id)] - (update-text-attrs {:id id :editor editor :attrs attrs}))))) + (update-text-attrs {:id id :editor editor :attrs attrs :typography? true}))))) (rx/of (dwu/commit-undo-transaction undo-id)))))))) (defn generate-typography-name diff --git a/frontend/src/app/render_wasm/shape.cljs b/frontend/src/app/render_wasm/shape.cljs index d94bd8d070..027d7ddcca 100644 --- a/frontend/src/app/render_wasm/shape.cljs +++ b/frontend/src/app/render_wasm/shape.cljs @@ -379,8 +379,9 @@ (def ^:private base-fields "Base fields of the `Shape` record this proxy stands in for: `cr/defrecord` nils them on dissoc instead of removing them, and the schema requires them." - #{:name :x :y :width :height :rotation :selrect :points - :transform :transform-inverse :parent-id :frame-id :flip-x :flip-y}) + {:name nil :x nil :y nil :width nil :height nil :rotation nil + :selrect nil :points nil :transform nil :transform-inverse nil + :parent-id nil :frame-id nil :flip-x nil :flip-y nil}) (defn- impl-dissoc [self k] @@ -429,7 +430,7 @@ [attrs] (ShapeProxy. (:id attrs) (:type attrs) - (into {} xf:without-id-and-type attrs))) + (into base-fields xf:without-id-and-type attrs))) (t/add-handlers! ;; We only add a write handler, read handler uses the dynamic dispatch diff --git a/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs b/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs index 2ffaf2de4a..e99c2e1e79 100644 --- a/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs +++ b/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs @@ -11,26 +11,175 @@ down on purpose, so a step that resolved early would see a half-synced file." (:require + [app.common.files.changes-builder :as pcb] + [app.common.logic.shapes :as cls] [app.common.math :as mth] + [app.common.test-helpers.components :as thc] [app.common.test-helpers.composable.comp.nodes :as n] + [app.common.test-helpers.composable.comp.runner :as r] [app.common.test-helpers.composable.comp.setups :as setup] [app.common.test-helpers.composable.comp.undo-check :as uc] [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.composable.gen :as cg] + [app.common.test-helpers.composable.oracle :as oracle] + [app.common.test-helpers.compositions :as tho] + [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] + [app.common.test-helpers.texts :as thtx] + [app.common.time :as ct] [app.main.data.workspace.libraries :as dwl] [app.main.data.workspace.reflow :as wrf] [app.main.data.workspace.shapes :as dwsh] + [app.main.data.workspace.texts :as dwt] + [app.main.data.workspace.thumbnails-wasm :as dwthw] [app.main.data.workspace.undo :as dwu] + [app.main.data.workspace.wasm-text :as dwwt] [app.main.store :as st] + [app.render-wasm.api :as wasm] + [app.util.text-editor :as ted] [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] + [clojure.test.check.generators :as gen] [frontend-tests.composable-tests.interpreter :as ftm] + [frontend-tests.helpers.async :as ha] [frontend-tests.helpers.mock :as mock] + [frontend-tests.helpers.wasm :as thw] [potok.v2.core :as ptk])) (t/use-fixtures :each ftm/fixture) +(t/deftest ^:async swapping-growing-text-undoes-with-the-component-choice + (let [features (:features @st/state)] + (thw/setup-wasm-mocks!) + (try + (await + (mock/with-mocks* + {wasm/text-editor-has-focus? (mock/stub (constantly false)) + dwthw/render-thumbnail (mock/stub (fn [& _] (ptk/data-event ::thumbnail-skipped)))} + (doseq [action [:swap :switch :multi-swap]] + (let [file (-> (thf/sample-file :file) + (tho/add-frame :root-a) + (thc/make-component :a :root-a) + (tho/add-frame-with-text :root-b :text-b "hello") + (ths/update-shape :text-b :grow-type :auto-height) + (thc/make-component :b :root-b) + (thc/instantiate-component :a :copy) + (thc/instantiate-component :a :copy2)) + situation (ftm/install! (tm/make-situation file)) + before (ftm/snapshot)] + (st/emit! #(update % :features (fnil conj #{}) "render-wasm/v1")) + (t/is (= :settled + (await (ftm/await-step + [(if (= action :multi-swap) + (dwl/component-multi-swap [(ths/get-shape file :copy) + (ths/get-shape file :copy2)] + (:id file) (thi/id :b)) + (dwl/component-swap (ths/get-shape file :copy) + (:id file) (thi/id :b) (= action :switch)))])))) + (let [after (ftm/snapshot) + root (ths/get-shape (ftm/current-file) :copy) + text (tm/shape-by-id (ftm/refresh-generated situation) (first (:shapes root)))] + (t/is (= (thi/id :b) (:component-id root))) + (t/is (mth/close? 20 (:height text))) + (t/is (empty? (:touched text))) + (t/is (= :settled (await (ftm/await-step [dwu/undo])))) + (t/is (uc/same-state? before (ftm/snapshot)) "one undo restores the old component") + (t/is (= :settled (await (ftm/await-step [dwu/redo])))) + (t/is (uc/same-state? after (ftm/snapshot)) "one redo restores the measured result")))))) + (finally + (thw/teardown-wasm-mocks!) + (st/emit! #(assoc % :features features)))))) + +(t/deftest ^:async applying-typography-settles-the-reference-and-undoes-in-one-step + (doseq [mode [:partial :inherited :editing-inherited]] + (let [expected [[{:line-height 1.6} + ["Read the guide" {:family "Roboto" :weight 700 :italic true :size 22 + :spacing 2 :case "uppercase" :typography :heading}]]] + file (-> (thf/sample-file :file1) + (ths/add-sample-typography :heading :font-id "gfont-roboto" :font-family "Roboto" + :font-variant-id "700italic" :font-weight "700" + :font-style "italic" :font-size "22" + :line-height "1.6" :letter-spacing "2" + :text-transform "uppercase" :path "Saved styles") + (thtx/add-text-component-with-copy (if (= mode :partial) + [[["Read the guide" {:size 22}]]] + expected))) + _ (ftm/install! (tm/make-situation file)) + before (ftm/snapshot) + typography (get-in file [:data :typographies (thi/id :heading)])] + (when (= mode :editing-inherited) + (st/emit! #(assoc-in % [:workspace-editor-state (thi/id :copy-child)] + (-> (ths/get-shape file :copy-child) :content ted/import-content + ted/create-editor-state ted/editor-select-all)))) + (t/is (= :settled + (await (ftm/await-step [(dwt/apply-typography #{(thi/id :copy-child)} typography (:id file))])))) + (let [after (ftm/snapshot) + after-file (ftm/current-file) + shape (ths/get-shape after-file :copy-child) + design #(oracle/canonical (tm/make-situation %) {:free-head-placement false}) + main-edit (dwt/update-text-attrs {:id (thi/id :main-child) :attrs {:font-size "30"}})] + (t/is (= expected (thtx/view (:content shape)))) + (t/is (= #{:content-group :text-content-typography :text-content-family + :text-content-weight :text-content-size :text-content-line-height + :text-content-spacing :text-content-case} + (:touched shape))) + (t/is (= :settled (await (ftm/await-step [dwu/undo])))) + (t/is (uc/same-state? before (ftm/snapshot))) + (t/is (= :settled (await (ftm/await-step [dwu/redo])))) + (t/is (uc/same-state? after (ftm/snapshot))) + (t/is (= :settled + (await (ftm/await-step [(dwl/sync-file (:id file) (:id file) :components (thi/id :component1))])))) + (t/is (oracle/equivalent? (design after-file) (design (ftm/current-file)))) + (t/is (= :settled (await (ftm/await-step [main-edit])))) + (t/is (= expected (thtx/text-of (ftm/current-file) :copy-child)) + "the applied typography keeps its size when the main changes"))))) + +(t/deftest ^:async sidebar-font-size-and-wasm-measurement-undo-together + (let [features (:features @st/state) + measured (atom nil) + font-size #(get-in % [:content :children 0 :children 0 :children 0 :font-size])] + (thw/setup-wasm-mocks!) + (try + (await + (mock/with-mocks* + {wasm/text-editor-has-focus? (mock/stub (constantly false)) + wasm/set-shape-text-content (mock/stub (fn [_ content] (reset! measured content))) + wasm/get-text-dimensions (mock/stub (fn [] {:x 0 :y 0 :width 100 :max-width 100 + :height (if (= "18" (font-size {:content @measured})) 29 35)})) + dwthw/render-thumbnail (mock/stub (fn [& _] (ptk/data-event ::thumbnail-skipped)))} + (let [text [[{:line-height 1.6} + ["Read the guide" {:family "Roboto" :weight 700 :italic true :size 22 + :spacing 2 :case "uppercase" :typography :heading}]]] + file (-> (thf/sample-file :file1) + (ths/add-sample-typography :heading :font-id "gfont-roboto" :font-family "Roboto" + :font-variant-id "700italic" :font-weight "700" + :font-style "italic" :font-size "22" + :line-height "1.6" :letter-spacing "2" :text-transform "uppercase") + (thtx/add-text-component-with-copy text)) + _ (ftm/install! (tm/make-situation file)) + typography (get-in file [:data :typographies (thi/id :heading)])] + (st/emit! #(update % :features (fnil conj #{}) "render-wasm/v1")) + (t/is (= :settled + (await (ftm/await-step [(dwwt/resize-wasm-text-all [(thi/id :main-child) (thi/id :copy-child)]) + (dwt/apply-typography #{(thi/id :copy-child)} typography (:id file))])))) + (let [before (ftm/snapshot)] + (t/is (= :settled + (await (ftm/await-step [(dwt/update-all-attrs [(thi/id :main-child)] + {:font-size "18" :typography-ref-id nil + :typography-ref-file nil})])))) + (let [after (ftm/snapshot)] + (t/is (= "18" (font-size (ths/get-shape (ftm/current-file) :main-child)))) + (t/is (= "22" (font-size (ths/get-shape (ftm/current-file) :copy-child)))) + (t/is (mth/close? 35 (:height (ths/get-shape (ftm/current-file) :copy-child)))) + (t/is (= :settled (await (ftm/await-step [dwu/undo])))) + (t/is (uc/same-state? before (ftm/snapshot)) "one undo restores styles and measured geometry") + (t/is (= :settled (await (ftm/await-step [dwu/redo])))) + (t/is (uc/same-state? after (ftm/snapshot)) "one redo restores styles and measured geometry")))))) + (finally + (thw/teardown-wasm-mocks!) + (st/emit! #(assoc % :features features)))))) + (t/deftest ^:async rotation-nodes-compose-successive-turns (let [initial (ftm/start-generated (setup/simple-component-with-labeled-copy)) first-turn (await (ftm/run-generated-step initial (n/rotate :copy-root 45))) @@ -39,6 +188,17 @@ (t/is (mth/close? 135 (:rotation shape) 0.01)) (t/is (empty? (uc/failures second-turn))))) +(t/deftest ^:async hiding-a-grid-main-child-then-moving-its-main-stays-synced + (loop [live (ftm/start-generated (cg/world [2 1 {:text true :text-styles true :layout :grid}])) + tuples [[:style 3 1 3 0] [:transform 0 0 0 0]]] + (when-let [tuple (first tuples)] + (let [resolved (cg/resolve-op live {} tuple) + next-live (await (ftm/run-generated-step live (:op resolved)))] + (t/is (some? next-live)) + (t/is (empty? (uc/failures next-live))) + (t/is (nil? (oracle/check next-live {}))) + (recur next-live (rest tuples)))))) + (def ^:private original "#abcdef") (def ^:private red "#ff0000") @@ -72,6 +232,105 @@ (dwsh/update-shapes #{(thi/id :main-child)} #(assoc % :fills (ths/sample-fills-color :fill-color color)))) +(defn- ^:async pending-sync-burst + [seed undo-before-release] + (let [sync-file dwl/sync-file + release (rx/behavior-subject false) + tail (gen/generate (gen/vector (gen/tuple (gen/return :edit) + (gen/choose 0 30) (gen/choose 0 1) + (gen/choose 1 2) (gen/return 0)) + 2 8) 20 seed) + tuples (into [[:edit 1 0 1 0]] tail) + initial (cg/initial-state [2 (mod seed 3)])] + (try + (await + (mock/with-mocks* + {dwl/sync-file (deferred-sync-file sync-file + (fn [event] + ;; The cascade is synchronous. Hold + ;; completion, not its input state. + (rx/concat (rx/of event) + (->> release (rx/filter true?) + (rx/take 1) (rx/ignore)))))} + (let [live (ftm/start-generated (:situation initial)) + result (reduce (fn [{:keys [state operations]} tuple] + (let [resolved (cg/resolve-op (:situation state) (:model state) tuple)] + {:state (-> state (cg/step tuple) cg/settle-state) + :operations (conj operations (:op resolved))})) + {:state initial :operations []} tuples) + operations (:operations result)] + (doseq [event (ftm/op->events (first operations) live)] (st/emit! event)) + (await (ha/wait-for #(seq (wrf/pending)) "first edit opens the held sync")) + (doseq [op (rest operations) + event (ftm/op->events op live)] + (st/emit! event)) + (t/is (seq (wrf/pending)) "later edits arrived while sync was pending") + (when undo-before-release (st/emit! dwu/undo)) + (let [expected (cond-> (:state result) + undo-before-release (-> (cg/step [:undo]) cg/settle-state))] + (rx/push! release true) + (t/is (= :settled (await (ftm/await-step [])))) + (oracle/check (ftm/refresh-generated live) (:model expected)) + (t/is (uc/same-state? (oracle/snapshot (:situation expected)) + (:files (ftm/snapshot))) + (str "seed " seed ", undo-before-release " undo-before-release)) + (let [depth (r/undo-depth (:situation expected)) + undone (loop [state expected remaining depth] + (if (zero? remaining) + state + (let [state (-> state (cg/step [:undo]) cg/settle-state)] + (t/is (= :settled (await (ftm/await-step [dwu/undo])))) + (t/is (uc/same-state? (oracle/snapshot (:situation state)) + (:files (ftm/snapshot))) + (str "burst undo seed " seed ", remaining " remaining)) + (recur state (dec remaining)))))] + (loop [state undone remaining depth] + (when (pos? remaining) + (let [state (-> state (cg/step [:redo]) cg/settle-state)] + (t/is (= :settled (await (ftm/await-step [dwu/redo])))) + (oracle/check (ftm/refresh-generated live) (:model state)) + (t/is (uc/same-state? (oracle/snapshot (:situation state)) + (:files (ftm/snapshot))) + (str "burst redo seed " seed ", remaining " remaining)) + (recur state (dec remaining)))))))))) + (finally + (ftm/uninstall!) + (rx/end! release))))) + +(t/deftest ^:async seeded-edits-arrive-during-pending-sync + (doseq [seed (range 12)] + (await (pending-sync-burst seed false)))) + +(t/deftest ^:async seeded-undo-arrives-during-pending-sync + (doseq [seed (range 12)] + (await (pending-sync-burst seed true)))) + +(t/deftest ^:async library-notification-keeps-copies-stale-but-reset-uses-the-new-main + (let [situation (cg/world [2 1 {:library true}]) + library (first (vals (tm/aux-files situation))) + page (thf/current-page library) + child (:shape (first (filter #(and (= :rect (get-in % [:shape :type])) + (nil? (get-in % [:shape :shape-ref]))) + (cg/tree (tm/with-file situation library))))) + root (get-in page [:objects (:parent-id child)]) + copies (filter #(= (:id child) (get-in % [:shape :shape-ref])) (cg/tree situation)) + first-copy (:shape (first copies)) + other-copy (:shape (second copies)) + changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page)) [(:id child)] + #(n/set-property % :fills red) (:objects page) {}) + edited (thf/apply-changes library changes) + cascaded (r/sync-cascade edited {} [(:component-id root)]) + changes (reduce pcb/concat-changes changes (:syncs cascaded)) + live (ftm/start-generated situation) + fill (fn [id] (get-in (tm/shape-by-id (ftm/refresh-generated live) id) [:fills 0 :fill-color]))] + (t/is (= :settled (await (ftm/await-step [(dwl/ext-library-changed (:id library) (ct/now) 1 + (:redo-changes changes))])))) + (t/is (= setup/labeled-fill (fill (:id first-copy)))) + (t/is (= setup/labeled-fill (fill (:id other-copy)))) + (t/is (= :settled (await (ftm/await-step [(dwl/reset-component (:parent-id first-copy))])))) + (t/is (= red (fill (:id first-copy)))) + (t/is (= setup/labeled-fill (fill (:id other-copy)))))) + (t/deftest ^:async edit-step-waits-for-slow-sync (let [sync-file dwl/sync-file] (await diff --git a/frontend/test/frontend_tests/composable_tests/generated_test.cljs b/frontend/test/frontend_tests/composable_tests/generated_test.cljs index 69a7d54726..a65ee91408 100644 --- a/frontend/test/frontend_tests/composable_tests/generated_test.cljs +++ b/frontend/test/frontend_tests/composable_tests/generated_test.cljs @@ -10,6 +10,7 @@ [app.common.test-helpers.composable.core :as tm] [app.common.test-helpers.composable.gen :as cg] [app.common.test-helpers.composable.oracle :as oracle] + [app.common.test-helpers.files :as cthf] [app.common.test-helpers.normalize :as thn] [app.main.repo :as rp] [beicon.v2.core :as rx] @@ -55,13 +56,19 @@ next-state (-> state (cg/step tuple) (cg/settle-state))] (when-not next-live (throw (ex-info "Frontend step failed" {:program program :tuple tuple}))) + (when (and (:op actual) (#{:resize :rotate :transform} (first tuple))) + (oracle/check-requested-geometry + (:objects (cthf/current-page (tm/file next-live))) + (tm/shape-by-id next-live (get-in actual [:shape :id])) + (cg/requested-geometry live actual (first tuple)))) (try (oracle/check next-live (live-model next-state next-live)) (catch :default error (throw (ex-info (str "Frontend oracle at " tuple ": " (ex-message error)) (ex-data error) error)))) - (let [expected (oracle/canonical (:situation next-state)) - actual (oracle/canonical next-live)] + (let [parity {:relative-free-head-placement true} + expected (oracle/canonical (:situation next-state) parity) + actual (oracle/canonical next-live parity)] (t/is (true? (oracle/equivalent? expected actual)) (str "Backend mismatch at " tuple "; replay " (pr-str program) "; diff " (pr-str (thn/diff expected actual))))) @@ -81,6 +88,53 @@ rx/timer mock/timer-mock} (await (replay-program program))))) +(t/deftest ^:async nesting-a-swapped-copy-in-a-blocked-main-authors-its-lock + (await (replay {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:style 3 2 1] [:swap 0 0 0 0] [:nest 0 0 0 0] + [:undo] [:redo]]}))) + +(t/deftest ^:async detaching-a-rotated-switched-copy-keeps-nested-placement-stable + (await (replay {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:duplicate 1 0 0 0] [:duplicate 1 0 0 0] [:switch 3 0 0 0] + [:rotate 5 0 0 0] [:detach 5 0 0 0] + [:undo] [:undo] [:undo] [:undo] [:undo] + [:redo] [:redo] [:redo] [:redo] [:redo]]}))) + +(t/deftest ^:async geometry-actions-replay-on-mains-and-copy-descendants + (doseq [action (range 6) scope (range 5)] + (await (replay {:world [2 2] + :ops [[:transform 0 action 3 scope] [:undo] [:redo]]})))) + +(t/deftest ^:async text-style-units-replay-through-editor-commits + (doseq [unit (range 12)] + (await (replay {:world [2 1 {:text true :text-styles true}] + :ops [[:text-style 1 unit 1] [:undo] [:redo]]})))) + +(t/deftest ^:async reflecting-a-rotated-copy-settles-descendant-flips + (await (replay {:world [2 1 {:text true :layout :grid}] + :ops [[:rotate 1] [:transform 2 16 0 9]]}))) + +(t/deftest ^:async swapping-after-a-resized-variant-keeps-child-placement + (await (replay {:world [2 2 {:variants true :variant-diff false :rich-variants true + :text true :layout nil :layout-copies true}] + :ops [[:resize 0] [:switch 0] [:swap 0]]}))) + +(t/deftest ^:async switching-after-a-main-move-and-child-removal-stays-settled + (await (replay {:world [2 0 {:library true :variants true :rich-variants true :text true + :layout :flex :layout-copies true}] + :ops [[:delete 0] [:restore 0] [:transform 4 0 0 0] [:remove-child 8] + [:style 5 7 0 0] [:switch 4] [:rotate 0 2 0 0]]}))) + +(t/deftest ^:async reflecting-a-rotated-nested-copy-settles-descendant-flips + (await (replay {:world [2 1 {:text true :layout :grid}] + :ops [[:nest 11] [:rotate 1] [:transform 2 16 0 18]]}))) + +(t/deftest ^:async detach-keeps-an-authored-swap-inside-a-surviving-copy + (await (replay {:world [2 2 {:variants true :variant-diff false}] + :ops [[:switch 10] [:switch 0] [:detach 2]]}))) + (t/deftest ^:async seeded-programs-replay-through-the-frontend (doseq [seed [712 20261022 1792691]] (await (replay (gen/generate cg/program-gen 20 seed))))) @@ -92,6 +146,10 @@ (doseq [seed [712 20261022]] (await (replay (gen/generate cg/structure-program-gen 10 seed))))) +(t/deftest ^:async moving-a-copy-child-uses-its-own-pre-edit-frame + (await (replay {:world [2 1] + :ops [[:transform 0 3 0 2] [:transform 0 0 2 2] [:undo] [:redo]]}))) + (t/deftest ^:async nested-text-rotation-shrunk-regression (await (replay {:world [2 0 {:text true}] :ops [[:nest 0] [:detach 0] [:rotate 0]]}))) @@ -273,6 +331,18 @@ [:resize 0 0 0 0] [:switch 2 0 0 0] [:rotate 1 0 0 0] [:remove-child 0 0 0 0]]}))) +(t/deftest ^:async applying-main-typography-drops-a-mixed-copys-link-without-an-override + (await (replay {:world [2 0 {:library true :variants true :rich-variants true + :text true :text-styles true :layout nil :layout-copies true}] + :ops [[:swap 0 0 0 0] [:text 23 3 1 0] [:text-style 22 8 1] + [:undo] [:undo] [:undo] [:redo] [:redo] [:redo]]}))) + +(t/deftest ^:async detaching-after-a-nested-switch-keeps-placement-stable-through-sync + (await (replay {:world [2 2 {:library true :variants true :rich-variants true + :text true :text-styles true :layout :flex :layout-copies true}] + :ops [[:nest 7 0 0 0] [:switch 3 0 0 0] [:style 3 7 1] [:detach 6 0 0 0] + [:undo] [:undo] [:undo] [:undo] [:redo] [:redo] [:redo] [:redo]]}))) + (t/deftest ^:async generated-library-switch-keeps-overrides-from-a-deleted-near-main (await (replay {:world [2 1 {:library true :variants true}] :ops [[:edit 0 0 1 2] [:update-main 0] [:library-sync] diff --git a/frontend/test/frontend_tests/composable_tests/interpreter.cljs b/frontend/test/frontend_tests/composable_tests/interpreter.cljs index bf9f8b6f5f..a07ec18f1c 100644 --- a/frontend/test/frontend_tests/composable_tests/interpreter.cljs +++ b/frontend/test/frontend_tests/composable_tests/interpreter.cljs @@ -17,7 +17,9 @@ [app.common.data :as d] [app.common.files.changes-builder :as pcb] [app.common.files.tokens :as cfo] + [app.common.geom.rect :as grc] [app.common.logic.shapes :as cls] + [app.common.test-helpers.composable.comp.files :as cf] [app.common.test-helpers.composable.comp.nodes :as n] [app.common.test-helpers.composable.comp.undo-check :as uc] [app.common.test-helpers.composable.core :as tm] @@ -82,9 +84,8 @@ (declare uninstall!) ;; Whether shapes were WASM shape proxies before the running test. A test that -;; starts the WASM renderer leaves `cts/wasm-enabled?` on for the tests after -;; it, and a proxy leaves out the attributes that are nil or false, so the -;; cases run on shape records whatever ran before them. +;; starts the WASM renderer can leave `cts/wasm-enabled?` on for later tests. +;; Cases use records; renderer boundary tests opt into proxies explicitly. (defonce ^:private wasm-shapes-before (atom nil)) (def fixture @@ -161,12 +162,16 @@ id (tm/target-shape-id situation target) shape (tm/shape-by-id situation id) {:keys [content name]} (n/text-edit-commit shape edit value)] - [(dwtx/v2-update-text-shape-content id content - :update-name? (some? name) - :name name - :finalize? true - :save-undo? true - :original-content (:content shape))]) + (if-let [{typography-id :id file-id :file-id} (:typography op)] + [(dwtx/apply-typography #{id} + (get-in (cf/all-files situation) [file-id :data :typographies typography-id]) + file-id)] + [(dwtx/v2-update-text-shape-content id content + :update-name? (some? name) + :name name + :finalize? true + :save-undo? true + :original-content (:content shape))])) (instance? n/Rotate op) ;; A node turns by its angle, including after an earlier rotation. @@ -177,7 +182,7 @@ ;; the sidebar position, in page coordinates (let [{:keys [target dx dy]} op id (tm/target-shape-id situation target) - {:keys [x y]} (:selrect (tm/shape-by-id situation id))] + {:keys [x y]} (grc/points->rect (:points (tm/shape-by-id situation id)))] [(dwt/update-position id {:x (+ x dx) :y (+ y dy)} {:absolute? true})]) (instance? n/ChangeHeight op) @@ -185,10 +190,23 @@ (let [{:keys [target value]} op] [(dwt/update-dimensions [(tm/target-shape-id situation target)] :height value)]) + (instance? n/TransformShape op) + (let [{:keys [target action value]} op + id (tm/target-shape-id situation target) + shape (tm/shape-by-id situation id)] + (case action + :move (let [[dx dy] value + {:keys [x y]} (grc/points->rect (:points shape))] + [(dwt/update-position id {:x (+ x dx) :y (+ y dy)} {:absolute? true})]) + (:width :height) [(dwt/update-dimensions [id] action value)] + :rotate [(dwt/increase-rotation [id] value {:delta? true})] + :flip-x [(dwt/flip-horizontal-selected [id])] + :flip-y [(dwt/flip-vertical-selected [id])])) + (instance? n/SwapShape op) (let [{:keys [target to keep-touched?]} op] [(dwl/component-swap (tm/shape-by-id situation (tm/target-shape-id situation target)) - (:id (tm/file situation)) + (n/swap-target-file-id situation to) (n/swap-target-id situation to) (boolean keep-touched?))]) @@ -308,7 +326,7 @@ (instance? n/SyncFromLibrary op) ;; the library update the "library updated" dialog runs - [(dwl/sync-file (:current-file-id @st/state) (n/library-id situation))] + [(dwl/sync-file (:current-file-id @st/state) (or (:source op) (n/library-id situation)))] (instance? n/Undo op) (vec (repeat (:times op) dwu/undo)) @@ -456,6 +474,9 @@ (record-choices op)) op (unwrap op) record (cond-> (dissoc (into {} op) ::tm/id) + (and (instance? n/SyncFromLibrary op) (nil? (:source op))) + (dissoc :source) + (satisfies? n/IAppliedResult op) (merge (n/applied-result op before (tm/file situation))))] (tm/record-application situation op record))) diff --git a/frontend/test/frontend_tests/render_wasm/shape_test.cljs b/frontend/test/frontend_tests/render_wasm/shape_test.cljs new file mode 100644 index 0000000000..c141e65340 --- /dev/null +++ b/frontend/test/frontend_tests/render_wasm/shape_test.cljs @@ -0,0 +1,30 @@ +;; 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 frontend-tests.render-wasm.shape-test + (:require + [app.common.test-helpers.composable.gen :as cg] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [app.render-wasm.shape :as shape] + [cljs.test :as t])) + +(t/deftest fresh-proxies-keep-the-records-base-fields + (let [attrs {:id (uuid/next) :type :rect :name "Rect" :opacity 0.5} + expected (into {} (cts/map->Shape attrs)) + actual (shape/create-shape attrs)] + (t/is (= expected (into {} actual))) + (doseq [attr [:rotation :flip-x :flip-y :transform :transform-inverse]] + (t/testing (name attr) + (t/is (contains? actual attr)) + (t/is (= expected (into {} (dissoc (assoc actual attr true) attr)))))))) + +(t/deftest reflected-nested-proxies-undo-without-adding-flip-fields + (with-redefs [cts/wasm-enabled? true + cts/wasm-create-shape shape/create-shape] + (let [result (cg/run {:world [2 1 {:text true :layout :grid}] + :ops [[:nest 11] [:rotate 1] [:transform 2 16 0 18]]})] + (t/is (= 3 (count (:trace result))))))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index c6dd6f8c3e..23643bf330 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -109,6 +109,7 @@ [frontend-tests.render-dimensions-test] [frontend-tests.render-wasm.process-objects-test] [frontend-tests.render-wasm.serialization-test] + [frontend-tests.render-wasm.shape-test] [frontend-tests.render-wasm.text-editor-apply-styles-test] [frontend-tests.render-wasm.text-editor-caret-color-test] [frontend-tests.render-wasm.text-editor-content-range-test] @@ -295,6 +296,7 @@ 'frontend-tests.plugins.value-objects-test 'frontend-tests.render-wasm.process-objects-test 'frontend-tests.render-wasm.serialization-test + 'frontend-tests.render-wasm.shape-test 'frontend-tests.render-wasm.text-editor-apply-styles-test 'frontend-tests.render-wasm.text-editor-caret-color-test 'frontend-tests.render-wasm.text-editor-content-range-test