github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 22:10:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Add selective merge to file branches

Browse Source 
The branch compare panel now offers per-change selection, grouped by
the component each shape belongs to. Every summary entry carries a
stable change key (kind/page/id, the design-branches PoC format), and
the panel's checkboxes key on it.

merge-file-branch and update-branch-from-main take the deselected keys
as an excluded set. An excluded change is dropped on the user's word:
a conflicting entity resolves to the target side (the recorded choice,
per the no-silent-winner decision), and an excluded addition cascades
to its added descendants, so no emitted change references a parent the
merge does not create. A merge whose every change is excluded refuses
with :nothing-to-merge.

The update squash needs no filter: whatever excluded main work is
missing from the branch lands in the squashed net as a branch-side
delta, so the branch state still replays from its repositioned base.

AI-assisted-by: glm-5.3-flash
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
This commit is contained in:
Álvaro Tejero Cantero 2026-10-06 16:45:29 +02:00
parent 9fae01b79b
commit fe60e1a772
No known key found for this signature in database
9 changed files with 934 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
backend/src/app/rpc/commands/files_branch.clj
View File

@ -935,6 +935,10 @@
;; conflicts, a keyword id like :active-themes. A resolution is either a
;; whole-entity choice (:main/:branch) or a per-attr map {attr -> side}.
[:resolutions {:optional true} [:map-of :any [:or [:enum :main :branch] [:map-of :keyword [:enum :main :branch]]]]]
;; the compare panel's per-change selection as a set of change keys
;; (`app.common.files.branch-merge/change-key`): the entities the user
;; deselected, which the merge resolves to the target side
[:excluded {:optional true} [::sm/set :string]]
[:expected-main-revn {:optional true} ::sm/int]
;; when false (the default) the branch and its file are logically
;; deleted right after a successful merge, in the SAME transaction (so
@ -960,7 +964,7 @@
::climit/id [[:merge-file-branch/by-profile ::rpc/profile-id]
[:merge-file-branch/global]]}
[{:keys [::mbus/msgbus] :as cfg}
{:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions expected-main-revn keep-branch]}]
{:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions expected-main-revn keep-branch excluded]}]
(bp/with-policies
(check-branching-enabled!)
(let [branch (db/get* cfg :file-branch {:id branch-id})]
@ -1034,8 +1038,19 @@
(let [merge-summary (bm/compute-merge base-data (:data main-file)
branch-data :branch->main)
conflicts (:conflicts merge-summary)
resolved? (fn [c] (bm/conflict-resolved? c (get resolutions (:id c))))
;; an excluded conflict is resolved: the exclusion IS the
;; recorded choice, so it lands on the target side
;; (`bm/compute-changes`, `pp:vcs:ds-no-silent-winner`)
resolved? (fn [c] (or (contains? excluded (:key c))
(bm/conflict-resolved? c (get resolutions (:id c)))))
unresolved (remove resolved? conflicts)
;; the user deselected everything: refuse rather than
;; integrate nothing (the PoC's check at
;; `merge-file-branch@2feb570d3f`)
_ (when (bm/nothing-to-merge? merge-summary excluded)
(ex/raise :type :validation
:code :nothing-to-merge
:hint "select at least one change to merge"))
finish-branch!
(fn [ts]
@ -1076,7 +1091,8 @@
(let [{:keys [changes unsupported]}
(bm/compute-changes base-data (:data main-file) branch-data
(or resolutions {})
merge-summary)]
merge-summary
excluded)]
(cond
(seq unsupported)
(audited {:status :unsupported
@ -1181,6 +1197,10 @@
;; resolutions in UI terms: id -> :main (take main) | :branch (keep
;; branch) | {attr -> side} (per-attr)
[:resolutions {:optional true} [:map-of :any [:or [:enum :main :branch] [:map-of :keyword [:enum :main :branch]]]]]
;; the compare panel's per-change selection as a set of change keys
;; (`app.common.files.branch-merge/change-key`): main's changes the user
;; deselected, which the branch keeps its own value for
[:excluded {:optional true} [::sm/set :string]]
[:expected-main-revn {:optional true} ::sm/int]])
(defn- persist-branch-update!
@ -1234,7 +1254,7 @@
::climit/id [[:update-branch-from-main/by-profile ::rpc/profile-id]
[:update-branch-from-main/global]]}
[{:keys [::mbus/msgbus] :as cfg}
{:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions expected-main-revn]}]
{:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions expected-main-revn excluded]}]
(bp/with-policies
(check-branching-enabled!)
(let [branch (db/get* cfg :file-branch {:id branch-id})]
@ -1364,7 +1384,8 @@
(bm/compute-merge base-data main-raw branch-cmp :main->branch)
conflicts (:conflicts merge-summary)
resolved? (fn [c] (bm/conflict-resolved? c (get resolutions (:id c))))
resolved? (fn [c] (or (contains? excluded (:key c))
(bm/conflict-resolved? c (get resolutions (:id c)))))
unresolved (remove resolved? conflicts)
;; Resolutions arrive document-keyed (`:main` = main's value).
@ -1384,6 +1405,14 @@
(audited {:status :conflicts :conflicts conflicts :main-revn (:revn main-file)}
tpoint :update-from-main)
(bm/nothing-to-merge? merge-summary excluded)
;; the user deselected everything: refuse rather than
;; reposition the base over work nothing applies (the PoC's
;; check at `merge-file-branch@2feb570d3f`, mirrored here)
(ex/raise :type :validation
:code :nothing-to-merge
:hint "select at least one change to merge")
:else
;; target = branch, source = main -> changes that bring main's
;; net changes (and conflicts resolved to main) into the branch.
@ -1394,7 +1423,8 @@
(let [{:keys [changes unsupported]}
(bm/compute-changes base-data branch-cmp main-raw
(or inverted {})
merge-summary)]
merge-summary
excluded)]
(cond
(seq unsupported)
(audited {:status :unsupported
@ -1407,7 +1437,7 @@
(:changes merge-summary)))}
tpoint :update-from-main)
(and (empty? changes) (not branch-diverged?))
(and (empty? changes) (not branch-diverged?) (empty? excluded))
(let [ts (ct/now)]
;; the branch is in sync with main: the repositioned
;; base already represents the branch, so the op log
@ -1416,7 +1446,11 @@
;; be emptied only when what it encodes already sits in
;; the base. A diverged branch holds its own work in
;; that log, so it falls through to the squash below,
;; which re-derives the net against the new base.
;; which re-derives the net against the new base. The
;; shortcut needs no exclusion in play either: excluded
;; main work is NOT in the branch, so the branch differs
;; from the repositioned base and the squash has to
;; record that difference as a branch-side delta.
(db/delete! conn :file-branch-change {:branch-id branch-id})
;; in sync, so no row is copied and the pairs are all
;; the id space the base needs: unpaired rows stay

149
backend/test/backend_tests/rpc_file_branch_test.clj
View File

@ -2774,3 +2774,152 @@
(t/is (not= k-default k-ignore))
(t/is (not= k-default k-expand))
(t/is (not= k-ignore k-expand))))
;;; --- Selective merge: the exclusion set on the wire ---
(t/deftest merge-with-exclusion-applies-the-rest
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
proj-id (:default-project-id profile)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id proj-id})
create (:result (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "selective"}))
branch-id (:id create)
branch-file-id (:branch-file-id create)
keep-id (uuid/random)
drop-id (uuid/random)]
(t/testing "the branch adds two colors"
(apply-change* profile branch-file-id
{:type :add-color :color {:id keep-id :name "Keep" :color "#00ff00" :opacity 1}})
(apply-change* profile branch-file-id
{:type :add-color :color {:id drop-id :name "Drop" :color "#0000ff" :opacity 1}}))
(t/testing "the merge takes the selected change and leaves the excluded one out"
(let [out (th/command! {::th/type :merge-file-branch
::rpc/profile-id (:id profile)
:branch-id branch-id
:excluded #{(bm/change-key {:kind :color :id drop-id})}})]
(t/is (nil? (:error out)))
(t/is (= :merged (-> out :result :status))))
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)})
colors (-> out :result :data :colors)]
(t/is (contains? colors keep-id))
(t/is (not (contains? colors drop-id))))))))
(t/deftest merge-refuses-when-every-change-is-excluded
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
proj-id (:default-project-id profile)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id proj-id})
create (:result (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "nothing-selected"}))
branch-id (:id create)
branch-file-id (:branch-file-id create)
color-id (uuid/random)]
(apply-change* profile branch-file-id
{:type :add-color :color {:id color-id :name "Solo" :color "#ff0000" :opacity 1}})
(t/testing "a merge whose every change is excluded refuses with :nothing-to-merge"
(let [out (th/command! {::th/type :merge-file-branch
::rpc/profile-id (:id profile)
:branch-id branch-id
:excluded #{(bm/change-key {:kind :color :id color-id})}})
error (:error out)]
(t/is (some? error))
(t/is (= :nothing-to-merge (-> error ex-data :code))))
;; nothing was integrated and the branch survives the refusal
(t/is (= "open" (:status (first (th/db-query :file-branch {:id branch-id})))))
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)})]
(t/is (not (contains? (-> out :result :data :colors) color-id)))))
(t/testing "the update refuses the same way when every incoming change is excluded"
(let [main-id (uuid/random)]
(apply-change* profile (:id file)
{:type :add-color :color {:id main-id :name "Main" :color "#00ff00" :opacity 1}})
(let [out (th/command! {::th/type :update-branch-from-main
::rpc/profile-id (:id profile)
:branch-id branch-id
:excluded #{(bm/change-key {:kind :color :id main-id})}})
error (:error out)]
(t/is (some? error))
(t/is (= :nothing-to-merge (-> error ex-data :code))))
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id branch-file-id})]
(t/is (not (contains? (-> out :result :data :colors) main-id)))))))))
(t/deftest update-with-exclusion-replays-the-branch-from-its-base
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
proj-id (:default-project-id profile)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id proj-id})
create (:result (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "partial-update"}))
branch-id (:id create)
branch-file-id (:branch-file-id create)
main-1 (uuid/random)
main-2 (uuid/random)
own (uuid/random)]
;; main advances twice; the branch carries work of its own
(apply-change* profile (:id file)
{:type :add-color :color {:id main-1 :name "M1" :color "#111111" :opacity 1}})
(apply-change* profile (:id file)
{:type :add-color :color {:id main-2 :name "M2" :color "#222222" :opacity 1}})
(apply-change* profile branch-file-id
{:type :add-color :color {:id own :name "Own" :color "#333333" :opacity 1}})
(t/testing "the update takes main's selected change and keeps the excluded one out"
(let [out (th/command! {::th/type :update-branch-from-main
::rpc/profile-id (:id profile)
:branch-id branch-id
:excluded #{(bm/change-key {:kind :color :id main-1})}})]
(t/is (nil? (:error out)))
(t/is (= :updated (-> out :result :status))))
;; get-file derives the branch by replaying the squashed net over
;; the repositioned base: this state IS that replay
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id branch-file-id})
colors (-> out :result :data :colors)]
(t/is (contains? colors main-2))
(t/is (contains? colors own))
(t/is (not (contains? colors main-1))))
;; the base moved to main, and main still holds the excluded work
(let [[row] (th/db-query :file-branch {:id branch-id})
mf (th/db-get :file {:id (:id file)})]
(t/is (= (:revn mf) (:base-revn row))))
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)})]
(t/is (contains? (-> out :result :data :colors) main-1))))
(t/testing "the excluded main work is a branch-side delta over the new base"
;; the branch does not carry it and the base does, so the squashed
;; net records the difference as a change of the branch's own
(let [diff (:result (th/command! {::th/type :get-branch-diff
::rpc/profile-id (:id profile)
:branch-id branch-id}))]
(t/is (some #(and (= :color (:kind %))
(= main-1 (:id %))
(= :deleted (:status %)))
(:changes diff))))))))

386
common/src/app/common/files/branch_merge.cljc
View File

@ -1180,6 +1180,53 @@
:modify-delete :delete-modify} % %)))
entry)))
(defn change-key
"Stable identity of one comparison entry, and the key an exclusion set
(the compare panel's per-change selection, `compute-changes`'s
`excluded`) names a change by. Format `kind/context/id`, the format the
design-branches PoC used (`change-key` in
`common/src/app/common/files/merge.cljc@2feb570d3f`): `context` is the
entry's page (`:page-id`) or token set (`:set-id`) when it has one and
empty otherwise, and a keyword id is spelled by name. `compute-merge`
annotates every entry with this key and the merge filter computes the
same key per entity, so a key the panel sends names exactly one entity
of the comparison."
[{:keys [kind page-id set-id id]}]
(str (name kind) "/" (or page-id set-id "") "/" (if (keyword? id) (name id) id)))
(defn- shape-component-owner
"The component a shape belongs to: `{:component-id .. :component-name
..}` for the nearest main instance up its parent chain, or nil when the
shape belongs to none. The walk looks the shape up in `datas` in order
(the source side first), so an entity one side deleted still resolves
from the sides that carry it. The compare panel groups the per-change
selection by this (its `group-changes`, mirroring the design-branches
PoC's `component-owner-fn`)."
[datas page-id id]
(let [lookup (fn [id] (some (fn [data] (get-in data [:pages-index page-id :objects id])) datas))]
(loop [id id n 1000]
(when-let [shape (when (and (some? id) (not= id uuid/zero) (pos? n))
(lookup id))]
(if (ctk/main-instance? shape)
(let [cid (:component-id shape)]
{:component-id cid
:component-name (some (fn [data] (get-in data [:components cid :name])) datas)})
(recur (:parent-id shape) (dec n)))))))
(defn- decorate-entry
"One summary entry with its `change-key` and, where the entity belongs
to one, its owning component, so the compare panel can key and group
what it shows without re-deriving either."
[datas entry]
(let [owner (case (:kind entry)
:shape (shape-component-owner datas (:page-id entry) (:id entry))
:component (let [id (:id entry)]
{:component-id id
:component-name (some (fn [data] (get-in data [:components id :name])) datas)})
nil)]
(cond-> (assoc entry :key (change-key entry))
(some? owner) (merge owner))))
(defn- compute-merge*
"The comparison itself. Both arities of `compute-merge` land here rather
than one delegating to the other through the var, so that a test which
@ -1209,7 +1256,12 @@
;; so `:main->branch` (theirs=branch, ours=main) is renamed here
;; (see `doc-sides`)
changes (if update? (mapv doc-sides changes) changes)
conflicts (if update? (mapv doc-sides conflicts) conflicts)]
conflicts (if update? (mapv doc-sides conflicts) conflicts)
;; every entry carries its `change-key` and, where it has one, its
;; owning component: the compare panel selects and groups by them
decorate (partial decorate-entry [ours theirs base])
changes (mapv decorate changes)
conflicts (mapv decorate conflicts)]
{:changes changes
:conflicts conflicts
;; the tree-shape policies act per direction (`tree-modes`), so
@ -1252,6 +1304,18 @@
([base main branch dir {:keys [only-pages]}]
(compute-merge* base main branch dir only-pages)))
(defn nothing-to-merge?
"True when the summary carries change entries and `excluded` covers
every one of them: the user selected nothing, so a merge would integrate
nothing and the caller refuses with `:nothing-to-merge` instead (the
check `files_branch.clj::merge-file-branch@2feb570d3f` made on the PoC's
change list). A summary with no entries is NOT a refusal: there the
merge is a clean no-op that closes the branch."
[merge-summary excluded]
(let [entries (concat (:changes merge-summary) (:conflicts merge-summary))]
(and (seq entries)
(every? #(contains? excluded (change-key %)) entries))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MERGE -> CHANGES (clean changes plus resolved conflicts)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1560,8 +1624,13 @@
move on a new parent.
Returns `{:changes [...] :unsupported #{entries..}}`: the `:refuse`
alternatives report `:shape-orphan` entries naming the container
instead of a placement the merge cannot honour."
[base theirs ours resolutions page-id dir]
instead of a placement the merge cannot honour.
`excluded` is the merge's exclusion set (see `change-key`). The ids it
names get no change at all, and an excluded creation carries its whole
source subtree out with it (see `drop-ids`), so nothing the pass emits
can reference a parent the merge does not create."
[base theirs ours resolutions page-id dir excluded]
(let [bo (get-in base [:pages-index page-id :objects] {})
to (get-in theirs [:pages-index page-id :objects] {})
oo (get-in ours [:pages-index page-id :objects] {})
@ -1571,9 +1640,32 @@
snil= (fn [a b] (= (strip-nil-attrs a) (strip-nil-attrs b)))
{:keys [sbo sto soo reorders]} (classification-objects bo to oo)
;; Ids this pass must not touch: the ones the exclusion set names
;; (a clean change skipped, a conflict resolved to the target),
;; plus, under the dependents policy, every shape the source places
;; under an excluded creation — its added descendants and any
;; shape it reparented there ("an excluded addition leaves its
;; child shapes out"). The alternative policy, refusing the
;; exclusion and naming those shapes instead, stays documented;
;; this one is the working default because it keeps the tree sound
;; without a refusal round trip.
own-drop (into #{}
(filter (fn [id]
(contains? excluded (change-key {:kind :shape :page-id page-id :id id}))))
(set/union (set (keys bo)) (set (keys to)) (set (keys oo))))
drop-ids (into own-drop
(mapcat (fn [id]
(when (and (contains? oo id) (not (contains? to id)))
(subtree-ids oo id))))
own-drop)
keep? (complement drop-ids)
;; modifications + deletions (additions handled below, ordered)
mod-del
(->> (flat-changes sbo sto soo resolutions
(->> (flat-changes (into {} (filter (fn [[id _]] (keep? id))) sbo)
(into {} (filter (fn [[id _]] (keep? id))) sto)
(into {} (filter (fn [[id _]] (keep? id))) soo)
resolutions
(fn [_ _] nil)
(fn [id _]
(let [res (get resolutions id)
@ -1615,12 +1707,15 @@
(not (snil= (get sbo id) (get soo id))))))
(when-let [r (lost-root bo to oo id)]
[id r]))))
(keys oo))
(filter keep? (keys oo)))
lost (into {} lost-pairs)
;; same-parent reorders, on the tree as the target has it
;; same-parent reorders, on the tree as the target has it. A
;; reordered parent the exclusion names keeps the target's order
reorder-changes (when (= :merge order-mode)
(page-reorder-changes to oo sbo sto reorders resolutions page-id))
(page-reorder-changes to oo sbo sto
(into {} (remove (fn [[id _]] (contains? drop-ids id))) reorders)
resolutions page-id))
;; `:dropped` `:expand`/`:page-root`: the target's shapes the
;; deleted container would take with it move out before the delete
@ -1636,7 +1731,8 @@
;; still has — it moved them out before deleting)
additions (into #{}
(filter (fn [id]
(and (contains? oo id)
(and (keep? id)
(contains? oo id)
(not (contains? bo id))
(not (contains? to id)))))
(keys oo))
@ -1654,12 +1750,14 @@
;; whole subtree comes back.
restore-set
(into #{}
(remove #(contains? to %))
(remove (fn [id] (or (contains? to id) (contains? drop-ids id))))
(into #{}
(mapcat #(subtree-ids oo %))
(cond
(= :conflict lost-mode)
(into #{} (comp (filter (fn [[_ r]] (= :branch (get resolutions r))))
(into #{} (comp (filter (fn [[_ r]]
(and (keep? r)
(= :branch (get resolutions r)))))
(map second))
lost-pairs)
@ -1668,7 +1766,8 @@
:else
(keep (fn [id]
(when (and (contains? bo id)
(when (and (keep? id)
(contains? bo id)
(not (contains? to id))
(not (snil= (get sbo id) (get soo id)))
(= :branch (get resolutions id)))
@ -1715,8 +1814,17 @@
ordered)
;; reparenting of EXISTING shapes — applied last, after new
;; containers exist and attr/add changes settled
move-changes (page-move-changes to oo sbo sto resolutions page-id)
;; containers exist and attr/add changes settled. A move whose
;; shape the exclusion dropped cannot travel, and neither can one
;; into a source-side parent the merge does not create (an
;; excluded addition), which would orphan it
move-changes (into []
(remove (fn [{:keys [parent-id shapes]}]
(or (contains? drop-ids (first shapes))
(and (contains? oo parent-id)
(not (contains? to parent-id))
(not (contains? all-adds parent-id))))))
(page-move-changes to oo sbo sto resolutions page-id))
;; `:refuse`: the merge cannot place these shapes where they
;; belong, so it refuses instead, naming the container
@ -1759,37 +1867,75 @@
The 5-arity accepts the `compute-merge` summary the caller usually
already computed (for the conflict gate), so the full three-way diff is
not run a second time just to derive `:unsupported`."
not run a second time just to derive `:unsupported`. The 6-arity takes
the EXCLUSION SET on top: a set of `change-key` strings naming the
entities the compare panel's user deselected.
An excluded entity is treated as resolved to the TARGET side: no change
is emitted for it and the target keeps its own value. That is the
recorded choice, not a silent win for one side (see
`pp:vcs:ds-no-silent-winner`): the user deselected the change, so the
result is exactly what the target has, and a conflicting entity lands
there whatever `resolutions` says. Excluding an added shape cascades to
every shape the source places under it (its added descendants and any
shape it reparented there), so no emitted change can reference a parent
the merge does not create; the alternative policy, refusing the
exclusion and naming those shapes instead, stays documented and is not
the working default."
([base main branch]
(compute-changes base main branch {}))
([base main branch resolutions]
(compute-changes base main branch resolutions nil))
([base main branch resolutions merge-summary]
(compute-changes base main branch resolutions merge-summary nil))
([base main branch resolutions merge-summary excluded]
(let [merge-summary (or merge-summary (compute-merge base main branch :branch->main))
unsupported (unsupported-kinds (concat (:changes merge-summary) (:conflicts merge-summary)))
resolutions (or resolutions {})
excluded (or excluded #{})
;; a kind no pass can translate refuses the merge UNLESS the user
;; excluded the entry carrying it: an excluded change is dropped
;; on the user's word, never silently
unsupported (->> (concat (:changes merge-summary) (:conflicts merge-summary))
(remove #(contains? excluded (change-key %)))
(unsupported-kinds))
excl? (fn [kind ctx id]
(contains? excluded (change-key (assoc ctx :kind kind :id id))))
drop-ex (fn [kind ctx coll]
(if (empty? excluded)
coll
(into {} (remove (fn [[id _]] (excl? kind ctx id))) coll)))
;; an excluded entity is dropped from the three collections of
;; every flat pass, so the pass sees it as absent on all three
;; sides and emits nothing for it: a clean change is skipped and
;; a conflicting entity lands on the target's value
flat (fn [kind ctx b t o add-fn mod-fn del-fn]
(flat-changes (drop-ex kind ctx b) (drop-ex kind ctx t) (drop-ex kind ctx o)
resolutions add-fn mod-fn del-fn))
;; colors/typographies classified without :modified-at (the apply
;; regenerates it via `touch`, so the emitted values may omit it)
colors (flat-changes (strip-modified-at (:colors base))
(strip-modified-at (:colors main))
(strip-modified-at (:colors branch))
resolutions
(fn [_ o] {:type :add-color :color o})
(fn [_ o] {:type :mod-color :color o})
(fn [id] {:type :del-color :id id}))
colors (flat :color {}
(strip-modified-at (:colors base))
(strip-modified-at (:colors main))
(strip-modified-at (:colors branch))
(fn [_ o] {:type :add-color :color o})
(fn [_ o] {:type :mod-color :color o})
(fn [id] {:type :del-color :id id}))
typos (flat-changes (strip-modified-at (:typographies base))
(strip-modified-at (:typographies main))
(strip-modified-at (:typographies branch))
resolutions
(fn [_ o] {:type :add-typography :typography o})
(fn [_ o] {:type :mod-typography :typography o})
(fn [id] {:type :del-typography :id id}))
typos (flat :typography {}
(strip-modified-at (:typographies base))
(strip-modified-at (:typographies main))
(strip-modified-at (:typographies branch))
(fn [_ o] {:type :add-typography :typography o})
(fn [_ o] {:type :mod-typography :typography o})
(fn [id] {:type :del-typography :id id}))
media (flat-changes (:media base) (:media main) (:media branch) resolutions
(fn [_ o] {:type :add-media :object o})
(fn [_ o] {:type :mod-media :object o})
(fn [id] {:type :del-media :id id}))
media (flat :media {}
(:media base) (:media main) (:media branch)
(fn [_ o] {:type :add-media :object o})
(fn [_ o] {:type :mod-media :object o})
(fn [id] {:type :del-media :id id}))
;; pages: add (full page incl. objects) / delete + rename (mod-page)
bpi (:pages-index base) mpi (:pages-index main) opi (:pages-index branch)
@ -1801,67 +1947,67 @@
;; requires main untouched; a delete conflict resolved to `:branch`
;; either deletes (branch deleted) or RESTORES the full branch page
;; via the add-fn (main deleted, branch edited)
page-presence (->> (flat-changes (page-content-map bpi bpids)
(page-content-map mpi mpids)
(page-content-map opi opids)
resolutions
(fn [pid _] {:type :add-page :page (get opi pid)})
(fn [_ _] nil)
(fn [pid] {:type :del-page :id pid}))
page-presence (->> (flat :page {}
(page-content-map bpi bpids)
(page-content-map mpi mpids)
(page-content-map opi opids)
(fn [pid _] {:type :add-page :page (get opi pid)})
(fn [_ _] nil)
(fn [pid] {:type :del-page :id pid}))
(filterv some?))
pmeta (fn [pi] (into {} (map (fn [id] [id (page-meta (get pi id))])) tri-common-pages))
bpm (pmeta bpi) tpm (pmeta mpi) opm (pmeta opi)
page-meta-changes (->> (flat-changes bpm tpm opm resolutions
(fn [_ _] nil)
(fn [pid m] (-> (page-meta-clears (get tpm pid) m)
(assoc :type :mod-page :id pid)))
(fn [_] nil))
page-meta-changes (->> (flat :page {} bpm tpm opm
(fn [_ _] nil)
(fn [pid m] (-> (page-meta-clears (get tpm pid) m)
(assoc :type :mod-page :id pid)))
(fn [_] nil))
(filterv some?))
;; page guides / flows per common page
page-guides (into []
(mapcat (fn [pid]
(flat-changes (get-in base [:pages-index pid :guides] {})
(get-in main [:pages-index pid :guides] {})
(get-in branch [:pages-index pid :guides] {})
resolutions
(fn [gid g] {:type :set-guide :page-id pid :id gid :params g})
(fn [gid g] {:type :set-guide :page-id pid :id gid :params g})
(fn [gid] {:type :set-guide :page-id pid :id gid :params nil}))))
(flat :page-guide {:page-id pid}
(get-in base [:pages-index pid :guides] {})
(get-in main [:pages-index pid :guides] {})
(get-in branch [:pages-index pid :guides] {})
(fn [gid g] {:type :set-guide :page-id pid :id gid :params g})
(fn [gid g] {:type :set-guide :page-id pid :id gid :params g})
(fn [gid] {:type :set-guide :page-id pid :id gid :params nil}))))
common-pages)
page-flows (into []
(mapcat (fn [pid]
(flat-changes (get-in base [:pages-index pid :flows] {})
(get-in main [:pages-index pid :flows] {})
(get-in branch [:pages-index pid :flows] {})
resolutions
(fn [fid f] {:type :set-flow :page-id pid :id fid :params f})
(fn [fid f] {:type :set-flow :page-id pid :id fid :params f})
(fn [fid] {:type :set-flow :page-id pid :id fid :params nil}))))
(flat :page-flow {:page-id pid}
(get-in base [:pages-index pid :flows] {})
(get-in main [:pages-index pid :flows] {})
(get-in branch [:pages-index pid :flows] {})
(fn [fid f] {:type :set-flow :page-id pid :id fid :params f})
(fn [fid f] {:type :set-flow :page-id pid :id fid :params f})
(fn [fid] {:type :set-flow :page-id pid :id fid :params nil}))))
common-pages)
;; page default-grids per common page
page-grids (into []
(mapcat (fn [pid]
(flat-changes (get-in base [:pages-index pid :default-grids] {})
(get-in main [:pages-index pid :default-grids] {})
(get-in branch [:pages-index pid :default-grids] {})
resolutions
(fn [gt p] {:type :set-default-grid :page-id pid :grid-type gt :params p})
(fn [gt p] {:type :set-default-grid :page-id pid :grid-type gt :params p})
(fn [gt] {:type :set-default-grid :page-id pid :grid-type gt :params nil}))))
(flat :page-grid {:page-id pid}
(get-in base [:pages-index pid :default-grids] {})
(get-in main [:pages-index pid :default-grids] {})
(get-in branch [:pages-index pid :default-grids] {})
(fn [gt p] {:type :set-default-grid :page-id pid :grid-type gt :params p})
(fn [gt p] {:type :set-default-grid :page-id pid :grid-type gt :params p})
(fn [gt] {:type :set-default-grid :page-id pid :grid-type gt :params nil}))))
common-pages)
;; page-level plugin-data per common page (flattened to [ns key] -> value)
page-plugins (into []
(mapcat (fn [pid]
(flat-changes (flatten-plugin-data (get-in base [:pages-index pid :plugin-data] {}))
(flatten-plugin-data (get-in main [:pages-index pid :plugin-data] {}))
(flatten-plugin-data (get-in branch [:pages-index pid :plugin-data] {}))
resolutions
(fn [[ns k] v] {:type :set-plugin-data :object-type :page :object-id pid :namespace ns :key k :value v})
(fn [[ns k] v] {:type :set-plugin-data :object-type :page :object-id pid :namespace ns :key k :value v})
(fn [[ns k]] {:type :set-plugin-data :object-type :page :object-id pid :namespace ns :key k :value nil}))))
(flat :page-plugin {:page-id pid}
(flatten-plugin-data (get-in base [:pages-index pid :plugin-data] {}))
(flatten-plugin-data (get-in main [:pages-index pid :plugin-data] {}))
(flatten-plugin-data (get-in branch [:pages-index pid :plugin-data] {}))
(fn [[ns k] v] {:type :set-plugin-data :object-type :page :object-id pid :namespace ns :key k :value v})
(fn [[ns k] v] {:type :set-plugin-data :object-type :page :object-id pid :namespace ns :key k :value v})
(fn [[ns k]] {:type :set-plugin-data :object-type :page :object-id pid :namespace ns :key k :value nil}))))
common-pages)
;; page order: reorder the common pages to branch's order via
@ -1872,7 +2018,8 @@
page-order-changes
(let [order-of (fn [data] (filterv tri-common-pages (or (:pages data) [])))
bo (order-of base) mo (order-of main) oo (order-of branch)]
(if (and (not= oo bo)
(if (and (not (excl? :page-order {} :page-order))
(not= oo bo)
(or (= mo bo) (= (get resolutions :page-order) :branch)))
(let [run-pages (reduce (fn [pages change]
(case (:type change)
@ -1911,21 +2058,22 @@
;; `page-shape-changes`); its `:unsupported` entries name the
;; container a `:refuse` alternative could not place under
dir (or (:dir merge-summary) :branch->main)
shapes-res (mapv (fn [pid] (page-shape-changes base main branch resolutions pid dir))
shapes-res (mapv (fn [pid] (page-shape-changes base main branch resolutions pid dir excluded))
common-pages)
shapes (into [] (mapcat :changes) shapes-res)
;; components: row metadata (shapes handled by the shape/page passes).
;; A branch soft-delete keeps the row with `:deleted true`; surface it
;; as a proper del-component so the deletion propagates.
components (flat-changes (strip-modified-at (:components base))
(strip-modified-at (:components main))
(strip-modified-at (:components branch)) resolutions
(fn [_ c] (assoc c :type :add-component))
(fn [id c] (if (:deleted c)
{:type :del-component :id id}
(assoc c :type :mod-component)))
(fn [id] {:type :del-component :id id}))
components (flat :component {}
(strip-modified-at (:components base))
(strip-modified-at (:components main))
(strip-modified-at (:components branch))
(fn [_ c] (assoc c :type :add-component))
(fn [id c] (if (:deleted c)
{:type :del-component :id id}
(assoc c :type :mod-component)))
(fn [id] {:type :del-component :id id}))
bl (:tokens-lib base) ml (:tokens-lib main) ol (:tokens-lib branch)
set-ids (set/union (lib-set-ids bl) (lib-set-ids ml) (lib-set-ids ol))
@ -1934,30 +2082,36 @@
;; a new set carries metadata only (tokens come from the per-token
;; pass); a RESTORED set (delete conflict resolved to `:branch`)
;; carries its tokens, since the per-token pass skips deleted sets
set-presence (->> (flat-changes (set-content-map bl)
(set-content-map ml)
(set-content-map ol)
resolutions
(fn [sid _] {:type :set-token-set :id sid :attrs (set-restore-attrs ol bl sid)})
(fn [_ _] nil)
(fn [sid] {:type :set-token-set :id sid :attrs nil}))
set-presence (->> (flat :token-set {}
(set-content-map bl)
(set-content-map ml)
(set-content-map ol)
(fn [sid _] {:type :set-token-set :id sid :attrs (set-restore-attrs ol bl sid)})
(fn [_ _] nil)
(fn [sid] {:type :set-token-set :id sid :attrs nil}))
(filterv some?))
;; set rename: take branch name/description, keep main's tokens
;; (the per-token pass then layers branch's token edits). Emitted
;; before token-vals.
;; before token-vals. An excluded rename leaves the target's name
;; standing, so the set-order moves below address that name.
common-sets (set/intersection (lib-set-ids bl) (lib-set-ids ml) (lib-set-ids ol))
rename-wins? (fn [sid]
(and (not (excl? :token-set-rename {} sid))
(set-rename-wins? bl ml ol resolutions sid)))
set-rename-changes
(into []
(comp (filter (fn [sid] (set-rename-wins? bl ml ol resolutions sid)))
(comp (filter rename-wins?)
(map (fn [sid] {:type :set-token-set :id sid :attrs (set-rename-attrs ml ol sid)})))
common-sets)
;; activation: each half settles the way `diff-tokens` classified
;; it, and one :set-tokens-status carries both, because the change
;; replaces the whole status
settle (fn [b m o k]
;; replaces the whole status. An excluded half settles to the
;; target's value, so the change leaves it as it is.
settle (fn [b m o kind k]
(cond
(excl? kind {} k) m
(= o b) m
(= m b) o
(= o m) m
@ -1965,8 +2119,10 @@
:else m))
main-theme-ids (active-theme-ids main)
main-set-ids (active-set-ids main)
theme-ids (settle (active-theme-ids base) main-theme-ids (active-theme-ids branch) :active-themes)
active-ids (settle (active-set-ids base) main-set-ids (active-set-ids branch) :active-sets)
theme-ids (settle (active-theme-ids base) main-theme-ids (active-theme-ids branch)
:token-active-themes :active-themes)
active-ids (settle (active-set-ids base) main-set-ids (active-set-ids branch)
:token-active-sets :active-sets)
active-changes
(if (and (= theme-ids main-theme-ids) (= active-ids main-set-ids))
[]
@ -1979,14 +2135,15 @@
(let [bo (set-order-by-id bl common-sets)
mo (set-order-by-id ml common-sets)
oo (set-order-by-id ol common-sets)]
(if (and (not= oo bo)
(if (and (not (excl? :token-set-order {} :token-set-order))
(not= oo bo)
(or (= mo bo) (= (get resolutions :token-set-order) :branch)))
;; the moves address the sets by name as the renames above
;; leave them: branch's name where the rename wins, main's
;; where main's rename stands
(let [names (mapv (fn [sid]
(ctob/get-name
(ctob/get-set (if (set-rename-wins? bl ml ol resolutions sid) ol ml) sid)))
(ctob/get-set (if (rename-wins? sid) ol ml) sid)))
oo)]
(vec (for [i (range (- (count names) 2) -1 -1)]
{:type :move-token-set
@ -2003,23 +2160,34 @@
(or (not (contains? (lib-set-ids ml) sid))
(not (contains? (lib-set-ids ol) sid))))))
set-ids)
;; a set whose creation the exclusion drops cannot take tokens:
;; its per-token pass goes with it (the dependents rule shapes
;; get in `page-shape-changes`), or the tokens would address a set
;; the merge never creates
dropped-sets (into #{}
(filter (fn [sid]
(and (not (contains? (lib-set-ids ml) sid))
(excl? :token-set {} sid))))
set-ids)
token-vals (into []
(comp (remove skip-set-ids)
(remove dropped-sets)
(mapcat (fn [sid]
(flat-changes (lib-tokens-by-id bl sid)
(lib-tokens-by-id ml sid)
(lib-tokens-by-id ol sid)
resolutions
(fn [tid t] {:type :set-token :set-id sid :token-id tid :attrs t})
(fn [tid t] {:type :set-token :set-id sid :token-id tid :attrs t})
(fn [tid] {:type :set-token :set-id sid :token-id tid :attrs nil})))))
(flat :token {:set-id sid}
(lib-tokens-by-id bl sid)
(lib-tokens-by-id ml sid)
(lib-tokens-by-id ol sid)
(fn [tid t] {:type :set-token :set-id sid :token-id tid :attrs t})
(fn [tid t] {:type :set-token :set-id sid :token-id tid :attrs t})
(fn [tid] {:type :set-token :set-id sid :token-id tid :attrs nil})))))
set-ids)
themes (flat-changes (lib-themes bl) (lib-themes ml) (lib-themes ol) resolutions
(fn [tid t] {:type :set-token-theme :id tid :attrs t})
(fn [tid t] {:type :set-token-theme :id tid :attrs t})
(fn [tid] {:type :set-token-theme :id tid :attrs nil}))]
themes (flat :token-theme {}
(lib-themes bl) (lib-themes ml) (lib-themes ol)
(fn [tid t] {:type :set-token-theme :id tid :attrs t})
(fn [tid t] {:type :set-token-theme :id tid :attrs t})
(fn [tid] {:type :set-token-theme :id tid :attrs nil}))]
{:unsupported (into unsupported (map :kind) (mapcat :unsupported shapes-res))
;; components before shapes so del-component can store the main-instance

166
common/test/common_tests/files_branch_merge_test.cljc
View File

@ -1213,9 +1213,11 @@
base (tree-data [f nil :frame "F"] [a f :rect "A"] [b f :rect "B"])
branch (tree-edit base assoc-in [f :shapes] [b a])
r (bm/compute-merge base base branch :branch->main)]
;; every summary entry carries its `change-key` as well (the compare
;; panel selects by it); the refusal content is what this asserts
(t/is (= [{:kind :shape-order :status :unsupported :id f :page-id (tree-page-id base)
:label "F" :policy :same-parent-reorder}]
(:changes r)))
(mapv #(dissoc % :key) (:changes r))))
(t/is (= #{:shape-order} (bm/unsupported-kinds (:changes r))))
(t/is (= #{:shape-order} (:unsupported (bm/compute-changes base base branch {})))))))
@ -1289,9 +1291,12 @@
main (tree-delete base p)
branch (tree-add base m p :rect "M")
r (bm/compute-merge base main branch :branch->main)]
;; every summary entry carries its `change-key` as well (the compare
;; panel selects by it); the refusal content is what this asserts
(t/is (= [{:kind :shape-orphan :status :unsupported :id p :page-id (tree-page-id base)
:label "P" :policy :addition-under-deleted-parent :shapes [m]}]
(filterv #(= :unsupported (:status %)) (:changes r))))
(mapv #(dissoc % :key)
(filterv #(= :unsupported (:status %)) (:changes r)))))
(t/is (= #{:shape-orphan} (:unsupported (bm/compute-changes base main branch {}))))
(let [branch (tree-edit base assoc-in [c :name] "C renamed")]
(t/is (= [[c :modify-delete]]
@ -1486,3 +1491,160 @@
branch (tree-add base m p :rect "M")
{:keys [unsupported]} (bm/compute-changes base main branch {} {:changes [] :conflicts []})]
(t/is (= #{:shape-orphan} unsupported)))))
;;; --- Selective merge: the exclusion set (`bm/change-key`) ---
(defn- orphan-parents
"Parent ids a change creates or moves a shape under that nothing the
merge emits provides: absent from `main` and never created by the
change list. A non-empty result is an orphan the translation let
through."
[main changes]
(let [created (into #{} (comp (filter #(= :add-obj (:type %))) (map :id)) changes)
kept (into created (keys (tree-objects main)))]
(into #{}
(comp (filter #(contains? #{:add-obj :mov-objects} (:type %)))
(map :parent-id)
(remove kept))
changes)))
(t/deftest change-key-is-stable-and-shape-scoped
(let [pid (uuid/next) id (uuid/next)]
(t/is (= (str "shape/" pid "/" id) (bm/change-key {:kind :shape :page-id pid :id id})))
(t/is (= "color//" (bm/change-key {:kind :color :id nil})))
(t/is (= "page-order//page-order" (bm/change-key {:kind :page-order :id :page-order})))
(t/is (= (str "token/" pid "/" id) (bm/change-key {:kind :token :set-id pid :id id})))
(t/is (= (bm/change-key {:kind :shape :page-id :p1 :id id})
(:key (first (filter #(= id (:id %))
(:changes (bm/compute-merge
(mkdata {})
(mkdata {})
(mkdata {id {:id id :name "A"}})
:branch->main)))))))))
(t/deftest excluded-clean-change-is-not-emitted
(let [a (uuid/next) b (uuid/next)
pid (uuid/custom 7 1)
base (tree-data [a nil :rect "A"])
branch (-> base
(tree-edit assoc-in [a :name] "A2")
(tree-add b nil :rect "B"))
ka (bm/change-key {:kind :shape :page-id pid :id a})
kb (bm/change-key {:kind :shape :page-id pid :id b})
all (:changes (bm/compute-changes base base branch {} nil #{}))
kept (:changes (bm/compute-changes base base branch {} nil #{ka}))
none (:changes (bm/compute-changes base base branch {} nil #{ka kb}))]
(t/is (= 2 (count all)))
(t/testing "the excluded modification stays out, the rest travels"
(t/is (= [b] (mapv :id (filter #(= :add-obj (:type %)) kept))))
(t/is (empty? (filter #(and (= :mod-obj (:type %)) (= a (:id %))) kept))))
(t/testing "every change excluded leaves nothing to apply"
(t/is (empty? none)))))
(t/deftest nothing-to-merge?-reads-the-whole-selection
(let [a (uuid/next)
base (tree-data [a nil :rect "A"])
branch (tree-edit base assoc-in [a :name] "A2")
summary (bm/compute-merge base base branch :branch->main)
ka (bm/change-key {:kind :shape :page-id (uuid/custom 7 1) :id a})]
(t/is (seq (:changes summary)))
(t/is (bm/nothing-to-merge? summary #{ka}))
(t/is (not (bm/nothing-to-merge? summary #{})))
(t/is (not (bm/nothing-to-merge? summary #{(str ka "-stale")})))
(t/testing "a summary with no entries is not a refusal: the merge closes the branch"
(t/is (not (bm/nothing-to-merge? (bm/compute-merge base base base :branch->main) #{}))))))
(t/deftest excluded-conflict-resolves-to-the-target
(let [a (uuid/next)
pid (uuid/custom 7 1)
base (tree-data [a nil :rect "A"])
main (tree-edit base assoc-in [a :name] "main")
branch (tree-edit base assoc-in [a :name] "branch")
ka (bm/change-key {:kind :shape :page-id pid :id a})]
(t/is (= 1 (count (:conflicts (bm/compute-merge base main branch :branch->main)))))
(t/testing "a :branch resolution still applies while the change is included"
(t/is (= 1 (count (:changes (bm/compute-changes base main branch {a :branch} nil #{}))))))
(t/testing "the exclusion is the recorded choice: the target keeps its value"
(let [{:keys [changes]} (bm/compute-changes base main branch {a :branch} nil #{ka})
data (cfc/process-changes main changes)]
(t/is (empty? changes))
(t/is (= "main" (get-in (tree-objects data) [a :name])))))))
(t/deftest excluding-an-addition-leaves-its-child-shapes-out
(let [g (uuid/next) c1 (uuid/next) c2 (uuid/next) m (uuid/next)
pid (uuid/custom 7 1)
base (tree-data [m nil :rect "M"])
branch (-> base
(tree-add g nil :frame "G")
(tree-add c1 g :rect "C1")
(tree-add c2 g :rect "C2")
(cfc/process-changes [{:type :mov-objects :page-id pid :parent-id g
:index 0 :shapes [m] :ignore-touched true}]))
kg (bm/change-key {:kind :shape :page-id pid :id g})
kc1 (bm/change-key {:kind :shape :page-id pid :id c1})]
(t/testing "without exclusions the additions and the move all travel"
(let [{:keys [changes]} (bm/compute-changes base base branch {} nil #{})]
(t/is (= #{g c1 c2} (into #{} (comp (filter #(= :add-obj (:type %))) (map :id)) changes)))
(t/is (empty? (orphan-parents base changes)))))
(t/testing "excluding the addition drops the whole added subtree and the move under it"
(let [{:keys [changes]} (bm/compute-changes base base branch {} nil #{kg})]
(t/is (empty? (filter #(= :add-obj (:type %)) changes)))
(t/is (empty? (filter #(and (= :mov-objects (:type %)) (= g (:parent-id %))) changes)))
(t/is (empty? (filter #(= m (:id %)) changes)))
(t/is (empty? (orphan-parents base changes)))))
(t/testing "excluding one descendant drops it alone and keeps the tree sound"
(let [{:keys [changes]} (bm/compute-changes base base branch {} nil #{kc1})]
(t/is (= #{g c2} (into #{} (comp (filter #(= :add-obj (:type %))) (map :id)) changes)))
(t/is (empty? (orphan-parents base changes)))))))
(t/deftest excluded-deletion-takes-no-relocation-with-it
;; under `:container-delete-over-main-edits :expand` the target's shapes
;; move out of a container the source deleted before it goes; excluding
;; that deletion keeps the container and takes no relocation with it
(binding [bm/*policies* (policies :container-delete-over-main-edits :expand)]
(let [f (uuid/next) x (uuid/next)
pid (uuid/custom 7 1)
base (tree-data [f nil :frame "F"] [x f :rect "X"])
;; the source deletes F whole while the target renamed X
branch (tree-delete base f)
main (tree-edit base assoc-in [x :name] "X renamed")
kf (bm/change-key {:kind :shape :page-id pid :id f})]
(t/testing "without the exclusion the delete lands with its relocation"
(let [{:keys [changes]} (bm/compute-changes base main branch {} nil #{})]
(t/is (= [f] (mapv :id (filter #(= :del-obj (:type %)) changes))))
(t/is (= 1 (count (filter #(= :mov-objects (:type %)) changes))))
(t/is (empty? (orphan-parents main changes)))))
(t/testing "the excluded container survives and nothing relocates out of it"
(let [{:keys [changes]} (bm/compute-changes base main branch {} nil #{kf})]
(t/is (empty? (filter #(= :del-obj (:type %)) changes)))
(t/is (empty? (filter #(= :mov-objects (:type %)) changes)))
(t/is (empty? (orphan-parents main changes))))))))
(t/deftest squashed-net-replays-the-updated-branch
;; the update-from-main invariant: whatever the exclusion keeps out of
;; the branch becomes a branch-side delta of the squashed net, so the
;; branch state still replays from its repositioned base
(let [a (uuid/next) b (uuid/next) c (uuid/next)
base (tree-data [a nil :rect "A"] [b nil :rect "B"])
main (-> (tree-edit base assoc-in [a :name] "A-main")
(tree-edit assoc-in [b :name] "B-main"))
branch (tree-add base c nil :rect "C")
kb (bm/change-key {:kind :shape :page-id (uuid/custom 7 1) :id b})
;; source = main, target = branch (the update direction)
{incoming :changes} (bm/compute-changes base branch main {} nil #{kb})
updated (cfc/process-changes branch incoming)
;; the repositioned base is main's own state
new-base main
{net :changes unsupported :unsupported} (bm/compute-changes new-base new-base updated {})]
(t/is (empty? unsupported))
(t/is (empty? (filter #(and (= :mod-obj (:type %)) (= b (:id %))) incoming)))
(t/is (= 1 (count incoming)))
(t/testing "the excluded main work stays in the net as a branch-side delta"
(t/is (some #(and (= :mod-obj (:type %)) (= b (:id %))) net))
(t/is (some #(and (= :add-obj (:type %)) (= c (:id %))) net)))
(t/testing "replaying the squashed net over the new base reproduces the branch"
(t/is (= (tree-objects updated)
(tree-objects (cfc/process-changes new-base net)))))))

81
frontend/src/app/main/data/workspace/branches.cljs
View File

@ -143,6 +143,11 @@
:unsupported-update-squash
(ntf/warn (tr "workspace.branches.update.unsupported"))
;; every change of the comparison was deselected: nothing to merge
;; or to update, and the branch stays as it is
:nothing-to-merge
(ntf/warn (tr "workspace.branches.merge.nothing-selected"))
(ntf/error fallback))))
;; --- Dashboard popover (list a file's branches from the dashboard)
@ -360,10 +365,19 @@
(ptk/reify ::fetch-branch-diff
ptk/UpdateEvent
(update [_ state]
(assoc state :workspace-branch-diff {:status :loading
:branch-id branch-id
:direction direction
:selected nil}))
(let [prev (:workspace-branch-diff state)]
(assoc state :workspace-branch-diff
{:status :loading
:branch-id branch-id
:direction direction
:selected nil
;; a refetch of the SAME comparison keeps the user's
;; per-change selection (it names the same entities); a
;; different branch or direction starts over
:excluded (if (and (= branch-id (:branch-id prev))
(= direction (:direction prev)))
(or (:excluded prev) #{})
#{})})))
ptk/WatchEvent
(watch [_ _ stream]
(->> (rp/cmd! :get-branch-diff {:branch-id branch-id :direction direction})
@ -380,6 +394,38 @@
(update [_ state]
(assoc-in state [:workspace-branch-diff :selected] selected))))
(defn toggle-diff-excluded
"Toggle the per-change selection of the current diff. `change-keys` are
change keys (`app.common.files.branch-merge/change-key`); a key the
selection holds is left OUT of the merge or update, and a key it lacks
travels. `include?` sets them all to that side instead of toggling (the
group checkbox): nil flips the whole batch, which is what a single row
checkbox needs too."
([change-keys] (toggle-diff-excluded change-keys nil))
([change-keys include?]
(assert (set? change-keys) "expected a set of change keys")
(ptk/reify ::toggle-diff-excluded
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-branch-diff :excluded]
(fn [excluded]
(let [excluded (or excluded #{})
include? (if (some? include?)
include?
(not (every? excluded change-keys)))]
(if include?
(apply disj excluded change-keys)
(into excluded change-keys)))))))))
(defn clear-diff-excluded
"Drop the per-change selection: the compare dialog closes without
applying it."
[]
(ptk/reify ::clear-diff-excluded
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-branch-diff :excluded] #{}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BRANCH CONTEXT (banner when the open file is a branch)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -446,7 +492,7 @@
`main-revn` is main's revn when the command computed those conflicts. It
is stored with them because the modal's own diff fetch can still be in
flight when the user applies; see `conflict-main-revn`."
[{:keys [branch mode conflicts main-revn]}]
[{:keys [branch mode conflicts main-revn excluded]}]
(ptk/reify ::open-conflict-resolutions
ptk/UpdateEvent
(update [_ state]
@ -457,9 +503,12 @@
:main-revn main-revn}))
ptk/WatchEvent
(watch [_ _ _]
;; `excluded` is the per-change selection the merge/update attempt
;; was made with; the resolution modal applies it on retry
(rx/of (modal/show :branch-conflicts {:branch branch
:mode mode
:conflicts conflicts})))))
:conflicts conflicts
:excluded excluded})))))
(defn- conflict-main-revn
"Main's revn when the server computed the conflict set stored for
@ -481,6 +530,11 @@
branch row. With conflicts and no `resolutions`, opens the conflict
resolution modal in update mode; with resolutions, applies them.
Options (`opts`): `:resolutions` `{entity-id (:main|:branch)}` as below,
and `:excluded`, the per-change selection (change keys,
`app.common.files.branch-merge/change-key`) naming main's changes the
user deselected, which the branch keeps its own value for.
When the current diff in state is this branch's `:main->branch` diff,
its main revn is sent as `expected-main-revn` so the server refuses to
apply resolutions computed against a stale diff (`:file-modified`); in
@ -489,7 +543,7 @@
loaded carry the revn of the conflict answer instead
(`conflict-main-revn`)."
([branch] (update-branch-from-main branch nil))
([branch resolutions]
([branch {:keys [resolutions excluded]}]
(ptk/reify ::update-branch-from-main
ptk/WatchEvent
(watch [_ state _]
@ -504,6 +558,7 @@
(rx/of (ev/event {::ev/name "update-branch-from-main"}))
(->> (rp/cmd! :update-branch-from-main (cond-> {:branch-id branch-id}
(seq resolutions) (assoc :resolutions resolutions)
(seq excluded) (assoc :excluded excluded)
(some? main-revn) (assoc :expected-main-revn main-revn)))
(rx/mapcat
(fn [{:keys [status conflicts] :as answer}]
@ -519,7 +574,8 @@
:conflicts (rx/of (open-conflict-resolutions {:branch branch
:mode :update
:conflicts conflicts
:main-revn (:main-revn answer)}))
:main-revn (:main-revn answer)
:excluded excluded}))
:unsupported (rx/of (ntf/warn (tr "workspace.branches.update.unsupported")))
(rx/of (ntf/error (tr "workspace.branches.update.error"))))))
(rx/catch
@ -584,6 +640,9 @@
under \"Archived\"); when false (default) the server deletes the
branch and its file in the same transaction, so merged copies do not
pile up and eat disk space.
- `:excluded` — the per-change selection (change keys,
`app.common.files.branch-merge/change-key`) naming the changes the
user deselected, which main keeps its own value for.
When the current diff in state belongs to this branch, its main revn is
sent as `expected-main-revn` so the server refuses to apply resolutions
@ -592,7 +651,7 @@
before that diff has loaded carry the revn of the conflict answer instead
(`conflict-main-revn`). Unresolved conflicts open the resolution modal."
([branch] (merge-branch branch nil))
([branch {:keys [resolutions keep-branch]}]
([branch {:keys [resolutions keep-branch excluded]}]
(assert (uuid? (:id branch)) "expected a branch row with a valid `:id`")
(ptk/reify ::merge-branch
ptk/WatchEvent
@ -608,6 +667,7 @@
(->> (rp/cmd! :merge-file-branch
(cond-> {:branch-id branch-id}
(seq resolutions) (assoc :resolutions resolutions)
(seq excluded) (assoc :excluded excluded)
keep-branch (assoc :keep-branch true)
(some? main-revn) (assoc :expected-main-revn main-revn)))
(rx/mapcat
@ -623,7 +683,8 @@
:conflicts (rx/of (open-conflict-resolutions {:branch branch
:mode :merge
:conflicts conflicts
:main-revn (:main-revn answer)}))
:main-revn (:main-revn answer)
:excluded excluded}))
:unsupported (rx/of (ntf/warn (tr "workspace.branches.merge.unsupported")))
(rx/of (ntf/error (tr "workspace.branches.merge.error"))))))
(rx/catch

209
frontend/src/app/main/ui/workspace/sidebar/branches.cljs
View File

@ -99,31 +99,7 @@
(or (get attr->label attr)
(-> (name attr) (str/replace #"-" " ") str/capital)))
;; --- Compare: grouping by category + per-item type labels
(def ^:private kind->category
{:shape :pages :page :pages :page-attrs :pages :page-order :pages
:page-guide :pages :page-flow :pages :page-grid :pages :page-plugin :pages
:component :components
:color :colors
:typography :typographies
:media :media
:token :tokens :token-set :tokens :token-set-rename :tokens :token-set-order :tokens
:token-theme :tokens :token-active-themes :tokens :token-active-sets :tokens})
(def ^:private category-order [:pages :components :colors :typographies :media :tokens])
(def ^:private category->icon
{:pages i/document :components i/component :colors i/picker
:typographies i/text :media i/img :tokens i/tokens})
(def ^:private category->label
{:pages "workspace.branches.compare.group.pages"
:components "workspace.branches.compare.group.components"
:colors "workspace.branches.compare.group.colors"
:typographies "workspace.branches.compare.group.typographies"
:media "workspace.branches.compare.group.media"
:tokens "workspace.branches.compare.group.tokens"})
;; --- Compare: grouping by component + per-item type labels
(def ^:private kind->type-label
{:shape "workspace.branches.compare.type.shape"
@ -401,7 +377,7 @@
(mf/defc merge-branch-dialog*
{::mf/register modal/components
::mf/register-as :merge-branch}
[{:keys [branch]}]
[{:keys [branch excluded]}]
(let [archive?* (mf/use-state false)
archive? (deref archive?*)
@ -425,9 +401,9 @@
on-submit
(mf/use-fn
(mf/deps branch archive?)
(mf/deps branch archive? excluded)
(fn [_]
(st/emit! (dwb/merge-branch branch {:keep-branch archive?})
(st/emit! (dwb/merge-branch branch {:keep-branch archive? :excluded excluded})
(modal/hide))))]
[:div {:class (stl/css :modal-overlay)}
@ -469,20 +445,25 @@
(defn- confirm-merge!
"Open the merge dialog for `branch` (merge into main is irreversible; the
dialog also lets the user choose whether to keep the branch archived)."
[branch]
(modal/show! :merge-branch {:branch branch}))
dialog also lets the user choose whether to keep the branch archived).
`excluded` is the compare dialog's per-change selection, if any."
([branch] (confirm-merge! branch nil))
([branch excluded]
(modal/show! :merge-branch {:branch branch :excluded excluded})))
(defn- confirm-update!
"Ask for confirmation before updating `branch` from main (overwrites
conflicting branch changes)."
[branch]
(st/emit! (modal/show {:type :confirm
:title (tr "workspace.branches.update.confirm-title")
:message (tr "workspace.branches.update.confirm-message" (:name branch))
:accept-label (tr "workspace.branches.update.confirm-accept")
:accept-style :primary
:on-accept (fn [_] (st/emit! (dwb/update-branch-from-main branch)))})))
conflicting branch changes). `excluded` is the compare dialog's
per-change selection, if any."
([branch] (confirm-update! branch nil))
([branch excluded]
(st/emit! (modal/show {:type :confirm
:title (tr "workspace.branches.update.confirm-title")
:message (tr "workspace.branches.update.confirm-message" (:name branch))
:accept-label (tr "workspace.branches.update.confirm-accept")
:accept-style :primary
:on-accept (fn [_] (st/emit! (dwb/update-branch-from-main branch
{:excluded excluded})))}))))
;; --- Diff counts: known, or honestly unknown
;;
@ -1089,9 +1070,40 @@
hex
(display-val value))]))
(defn- selectable-item?
"A row the per-change selection covers: a clean change. A conflict keeps
its resolution UI instead, and an `:unsupported` entry is a refusal the
merge raises whatever the selection says."
[item]
(contains? #{:added :modified :deleted} (:status item)))
(defn- group-changes
"Group the comparison's rows by the component they belong to (the
nearest main instance up a shape's tree, `:component-id` on the entry);
the rows of no component go last. The per-change selection is offered
per group, mirroring the design-branches PoC's `group-changes`
(`frontend/src/app/main/ui/workspace/branches.cljs@2feb570d3f`)."
[rows]
(->> rows
(group-by (fn [[_ item]] (:component-id item)))
(map (fn [[component-id group-rows]]
(let [item (second (first group-rows))
row-keys (into #{} (comp (filter (fn [[_ it]] (selectable-item? it)))
(map (fn [[_ it]] (:key it))))
group-rows)]
{:id (or (some-> component-id str) "other")
:component? (some? component-id)
:name (if component-id
(or (:component-name item)
(tr "workspace.branches.compare.group.component"))
(tr "workspace.branches.compare.group.other"))
:row-keys row-keys
:rows group-rows})))
(sort-by (juxt (complement :component?) :name))))
(mf/defc branch-compare-item*
{::mf/private true}
[{:keys [item index selected on-select]}]
[{:keys [item index selected on-select excluded? on-toggle]}]
(let [on-click (mf/use-fn (mf/deps index on-select) #(on-select index))
status (item-status item)
attrs (:changed-attrs item)
@ -1099,6 +1111,8 @@
icon-id (if (= :shape (:kind item))
(shape-icon-id item)
(get kind->icon (:kind item) i/git-branch))
selectable? (selectable-item? item)
change-key (:key item)
subtitle (cond
(= :added status) (tr "workspace.branches.compare.subtitle-new"
(if type-lbl (tr type-lbl) ""))
@ -1108,12 +1122,20 @@
:else nil)]
[:li {:class (stl/css-case :compare-item true
:is-selected (= index selected)
:is-excluded (and selectable? excluded?)
:status-added (= :added status)
:status-modified (= :modified status)
:status-deleted (= :deleted status)
:status-conflict (= :conflict status))
:role "button"
:on-click on-click}
[:span {:class (stl/css :compare-item-check)
;; the click must not also select the row for the detail pane
:on-click (fn [event] (when selectable? (.stopPropagation event)))}
(when selectable?
[:> checkbox* {:id change-key
:checked (not excluded?)
:on-change #(on-toggle #{change-key})}])]
[:div {:class (stl/css :compare-item-icon)}
[:> i/icon* {:icon-id icon-id}]]
[:div {:class (stl/css :compare-item-body)}
@ -1164,9 +1186,10 @@
{::mf/register modal/components
::mf/register-as :branch-compare}
[{:keys [branch]}]
(let [{:keys [status diff selected direction]} (mf/deref branch-diff)
(let [{:keys [status diff selected direction excluded]} (mf/deref branch-diff)
direction (or direction :branch->main)
incoming? (= direction :main->branch)
excluded (or excluded #{})
items
(mf/with-memo [diff]
@ -1180,25 +1203,38 @@
active-filter (deref active-filter*)
;; keep the original index for selection while filtering/grouping
indexed (map-indexed vector items)
filtered (filterv (fn [[_ it]] (status-matches? active-filter (item-status it))) indexed)
by-cat (group-by (fn [[_ it]] (get kind->category (:kind it) :pages)) filtered)
filtered (mf/with-memo [items active-filter]
(filterv (fn [[_ it]] (status-matches? active-filter (item-status it)))
(map-indexed vector items)))
groups (mf/with-memo [filtered]
(group-changes filtered))
on-close (mf/use-fn #(st/emit! (modal/hide)))
;; the selection covers the clean changes alone (see
;; `selectable-item?`), which is what the footer counts
all-keys (into #{} (comp (filter (fn [[_ it]] (selectable-item? it)))
(map (fn [[_ it]] (:key it))))
(map-indexed vector items))
kept-count (count (remove excluded all-keys))
on-close (mf/use-fn #(st/emit! (dwb/clear-diff-excluded)
(modal/hide)))
on-select (mf/use-fn #(st/emit! (dwb/select-diff-change %)))
on-toggle (mf/use-fn (fn [change-keys include?]
(st/emit! (dwb/toggle-diff-excluded change-keys include?))))
on-filter (mf/use-fn (fn [f] (reset! active-filter* f)))
on-swap (mf/use-fn (mf/deps branch direction)
#(st/emit! (dwb/fetch-branch-diff
(:id branch)
(if incoming? :branch->main :main->branch))))
on-merge (mf/use-fn (mf/deps branch)
#(confirm-merge! branch))
on-update (mf/use-fn (mf/deps branch)
#(confirm-update! branch))
on-resolve (mf/use-fn (mf/deps branch direction)
on-merge (mf/use-fn (mf/deps branch excluded)
#(confirm-merge! branch excluded))
on-update (mf/use-fn (mf/deps branch excluded)
#(confirm-update! branch excluded))
on-resolve (mf/use-fn (mf/deps branch direction excluded)
#(modal/show! :branch-conflicts
{:branch branch
:mode (if incoming? :update :merge)}))
:mode (if incoming? :update :merge)
:excluded excluded}))
on-export (mf/use-fn
(mf/deps diff branch)
(fn []
@ -1306,29 +1342,36 @@
(tr label)])]
[:div {:class (stl/css :compare-list)}
(for [cat category-order
:let [group (get by-cat cat)]
:when (seq group)]
[:div {:class (stl/css :compare-group) :key (name cat)}
[:div {:class (stl/css :compare-group-head)}
[:> i/icon* {:icon-id (get category->icon cat i/document) :size "s"}]
[:span {:class (stl/css :compare-group-label)} (tr (get category->label cat))]
(let [freqs (frequencies (map (fn [[_ it]] (item-status it)) group))]
[:span {:class (stl/css :compare-group-counts)}
(when (pos? (get freqs :added 0))
[:span {:class (stl/css :count-added)} (dm/str "+" (get freqs :added))])
(when (pos? (+ (get freqs :modified 0) (get freqs :conflict 0)))
[:span {:class (stl/css :count-modified)}
(dm/str "~" (+ (get freqs :modified 0) (get freqs :conflict 0)))])
(when (pos? (get freqs :deleted 0))
[:span {:class (stl/css :count-deleted)} (dm/str "−" (get freqs :deleted))])])]
[:ul {:class (stl/css :compare-group-items)}
(for [[idx item] group]
[:> branch-compare-item* {:key idx
:item item
:index idx
:selected selected
:on-select on-select}])]])]]
(for [{:keys [id name component? rows row-keys]} groups]
(let [all-included? (not-any? excluded row-keys)]
[:div {:class (stl/css :compare-group) :key id}
[:div {:class (stl/css :compare-group-head)}
(when (seq row-keys)
;; the group checkbox selects or deselects the group's
;; changes in one go
[:> checkbox* {:id (str "group-" id)
:checked all-included?
:on-change #(on-toggle row-keys (not all-included?))}])
[:> i/icon* {:icon-id (if component? i/component i/document) :size "s"}]
[:span {:class (stl/css :compare-group-label)} name]
(let [freqs (frequencies (map (fn [[_ it]] (item-status it)) rows))]
[:span {:class (stl/css :compare-group-counts)}
(when (pos? (get freqs :added 0))
[:span {:class (stl/css :count-added)} (dm/str "+" (get freqs :added))])
(when (pos? (+ (get freqs :modified 0) (get freqs :conflict 0)))
[:span {:class (stl/css :count-modified)}
(dm/str "~" (+ (get freqs :modified 0) (get freqs :conflict 0)))])
(when (pos? (get freqs :deleted 0))
[:span {:class (stl/css :count-deleted)} (dm/str "−" (get freqs :deleted))])])]
[:ul {:class (stl/css :compare-group-items)}
(for [[idx item] rows]
[:> branch-compare-item* {:key idx
:item item
:index idx
:selected selected
:excluded? (contains? excluded (:key item))
:on-select on-select
:on-toggle on-toggle}])]]))]]
[:div {:class (stl/css :compare-detail)}
[:> branch-compare-detail* {:item sel-item}]]])
@ -1343,6 +1386,10 @@
[:div {:class (stl/css :compare-footer-info)}
[:> i/icon* {:icon-id i/info :size "s"}]
[:span (tr "workspace.branches.compare.footer-changes" total)]
(when (seq all-keys)
[:span {:class (stl/css :compare-footer-selected)}
(tr "workspace.branches.compare.footer-selected"
(str kept-count) (str (count all-keys)))])
(when conflicts?
[:span {:class (stl/css :compare-footer-conflicts)}
(dm/str " · " (tr "workspace.branches.compare.footer-conflicts" conflicts))])]
@ -1363,14 +1410,14 @@
incoming?
[:> button* {:variant "primary"
:icon i/status-update
:disabled (zero? total)
:disabled (zero? kept-count)
:on-click on-update}
(tr "workspace.branches.update")]
:else
[:> button* {:variant "primary"
:icon i/git-merge
:disabled (zero? total)
:disabled (zero? kept-count)
:on-click on-merge}
(tr "workspace.branches.merge.action")])]]))]]))
@ -1579,7 +1626,7 @@
(mf/defc branch-conflicts-dialog*
{::mf/register modal/components
::mf/register-as :branch-conflicts}
[{:keys [branch mode conflicts]}]
[{:keys [branch mode conflicts excluded]}]
(let [{:keys [diff selected resolutions status]} (mf/deref branch-diff)
loading? (= status :loading)
@ -1633,11 +1680,13 @@
#(when sel (st/emit! (dwb/set-conflict-resolution (:id sel) :main))))
on-use-branch (mf/use-fn (mf/deps sel)
#(when sel (st/emit! (dwb/set-conflict-resolution (:id sel) :branch))))
on-apply (mf/use-fn (mf/deps branch resolutions mode keep?)
on-apply (mf/use-fn (mf/deps branch resolutions mode keep? excluded)
#(st/emit! (if (= mode :update)
(dwb/update-branch-from-main branch resolutions)
(dwb/update-branch-from-main branch {:resolutions resolutions
:excluded excluded})
(dwb/merge-branch branch {:resolutions resolutions
:keep-branch keep?}))))]
:keep-branch keep?
:excluded excluded}))))]
;; the fetched diff backs both the fallback conflict set and the side
;; subtitles, so it must be computed in the direction this modal resolves:

15
frontend/src/app/main/ui/workspace/sidebar/branches.scss
View File

@ -743,7 +743,7 @@
.compare-item {
display: grid;
grid-template-columns: auto 1fr auto;
grid-template-columns: auto auto 1fr auto;
align-items: center;
gap: var(--sp-s);
padding: var(--sp-s);
@ -757,6 +757,10 @@
background-color: var(--color-background-quaternary);
}
&.is-excluded {
opacity: 0.55;
}
&.status-added {
border-inline-start-color: var(--color-foreground-success);
}
@ -774,6 +778,11 @@
}
}
.compare-item-check {
display: flex;
align-items: center;
}
.compare-item-icon {
display: flex;
align-items: center;
@ -965,6 +974,10 @@
color: var(--color-foreground-warning);
}
.compare-footer-selected {
color: var(--color-foreground-secondary);
}
.compare-footer-actions {
display: flex;
align-items: center;

73
frontend/test/frontend_tests/data/workspace_branches_test.cljs
View File

@ -59,7 +59,7 @@
(ptk/emit! store (dwb/set-all-resolutions :main))
(let [resolutions (get-in @store [:workspace-branch-diff :resolutions])]
(ptk/emit! store (if (= mode :update)
(dwb/update-branch-from-main branch resolutions)
(dwb/update-branch-from-main branch {:resolutions resolutions})
(dwb/merge-branch branch {:resolutions resolutions})))))
(defn- last-params
@ -144,3 +144,74 @@
(rx/dispose! store))))
(done'))
done))))
;;; --- Selective merge: the per-change selection ---
(t/deftest the-per-change-selection-toggles-and-clears
(let [store (make-store)
k1 "color//aaaaaaaa/1"
k2 "color//aaaaaaaa/2"]
(t/testing "a row flips on its own"
(ptk/emit! store (dwb/toggle-diff-excluded #{k1}))
(t/is (= #{k1} (get-in @store [:workspace-branch-diff :excluded])))
(ptk/emit! store (dwb/toggle-diff-excluded #{k1}))
(t/is (= #{} (get-in @store [:workspace-branch-diff :excluded]))))
(t/testing "a group sets every key of it to one side"
(ptk/emit! store (dwb/toggle-diff-excluded #{k1 k2} false))
(t/is (= #{k1 k2} (get-in @store [:workspace-branch-diff :excluded])))
(ptk/emit! store (dwb/toggle-diff-excluded #{k1} false))
(t/is (= #{k1 k2} (get-in @store [:workspace-branch-diff :excluded])))
(ptk/emit! store (dwb/toggle-diff-excluded #{k1 k2} true))
(t/is (= #{} (get-in @store [:workspace-branch-diff :excluded]))))
(t/testing "closing the compare dialog drops the selection"
(ptk/emit! store (dwb/toggle-diff-excluded #{k1}))
(ptk/emit! store (dwb/clear-diff-excluded))
(t/is (= #{} (get-in @store [:workspace-branch-diff :excluded]))))))
(t/deftest a-refetch-of-the-same-comparison-keeps-the-selection
(t/async done
(let [calls (atom [])
branch {:id (uuid/next)}]
(mock/with-mocks
{rp/cmd! (cmd-stub calls (uuid/next))}
(fn [done']
(let [store (make-store)]
(ptk/emit! store (dwb/fetch-branch-diff (:id branch)))
(ptk/emit! store (dwb/toggle-diff-excluded #{"color//aaaaaaaa/1"}))
(t/testing "the same branch and direction refetches over the selection"
(ptk/emit! store (dwb/fetch-branch-diff (:id branch)))
(t/is (= #{"color//aaaaaaaa/1"}
(get-in @store [:workspace-branch-diff :excluded]))))
(t/testing "the other direction starts the selection over"
(ptk/emit! store (dwb/fetch-branch-diff (:id branch) :main->branch))
(t/is (= #{} (get-in @store [:workspace-branch-diff :excluded]))))
(rx/dispose! store)))
done))))
(t/deftest the-selection-travels-with-the-merge-and-update-calls
(t/async done
(let [calls (atom [])
conflict-id (uuid/next)]
(mock/with-mocks
{rp/cmd! (cmd-stub calls conflict-id)}
(fn [done']
(doseq [mode [:merge :update]]
(t/testing (name mode)
(let [branch {:id (uuid/next)}
store (make-store)
excluded #{"color//aaaaaaaa/1"}]
(reset! calls [])
(ptk/emit! store (if (= mode :update)
(dwb/update-branch-from-main branch {:excluded excluded})
(dwb/merge-branch branch {:excluded excluded})))
(t/is (= excluded (:excluded (last-params calls mode))))
(t/testing "an empty selection sends no `:excluded` at all"
(ptk/emit! store (if (= mode :update)
(dwb/update-branch-from-main branch)
(dwb/merge-branch branch)))
(t/is (not (contains? (last-params calls mode) :excluded))))
(rx/dispose! store))))
(done'))
done))))

16
frontend/translations/en.po
View File

@ -6374,10 +6374,18 @@ msgstr "%s changes"
msgid "workspace.branches.compare.footer-conflicts"
msgstr "%s to resolve before merging"
#: src/app/main/ui/workspace/sidebar/branches.cljs:1391
msgid "workspace.branches.compare.footer-selected"
msgstr "%s of %s selected"
#, unused
msgid "workspace.branches.compare.group.colors"
msgstr "Colors"
#: src/app/main/ui/workspace/sidebar/branches.cljs:1098
msgid "workspace.branches.compare.group.component"
msgstr "Component"
#, unused
msgid "workspace.branches.compare.group.components"
msgstr "Components"
@ -6386,6 +6394,10 @@ msgstr "Components"
msgid "workspace.branches.compare.group.media"
msgstr "Media"
#: src/app/main/ui/workspace/sidebar/branches.cljs:1099
msgid "workspace.branches.compare.group.other"
msgstr "Other changes"
#, unused
msgid "workspace.branches.compare.group.pages"
msgstr "Pages"
@ -7063,6 +7075,10 @@ msgstr ""
"Main changed while you were reviewing; the comparison has been reloaded, "
"please review and retry"
#: src/app/main/data/workspace/branches.cljs:149
msgid "workspace.branches.merge.nothing-selected"
msgstr "Select at least one change to merge"
#: src/app/main/data/workspace/branches.cljs:447
msgid "workspace.branches.merge.success"
msgstr "Branch merged into main"