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

✨ Report what a merge does to component copies

Browse Source 
The merge summary now says, for each component whose main the incoming
side changed, which copies will follow it after the integration and
which keep an override, per sync group and token slot. Each copy entry
lists what the copy rule settled, with the side and the reason, and
what the user still decides. A copy the rule settles entirely stays in
the summary as an informational entry instead of disappearing, and
applies nothing. A conflict on a component's main counts the copies
its resolution also decides.

AI-assisted-by: claude-opus-5-5
This commit is contained in:
Álvaro Tejero Cantero 2026-10-28 16:59:34 +01:00
parent f598e73bec
commit 95ad841ed5
No known key found for this signature in database
4 changed files with 599 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1099,7 +1099,8 @@
Conflicts that `resolutions` leaves unresolved make the command return
`{:status :conflicts}`, with the `:main-revn` they were computed against
so the retry can pass it as `expected-main-revn`; a resolved conflict
so the retry can pass it as `expected-main-revn` and the summary's
`:copies` (`bm/compute-merge`); a resolved conflict
merges the side its resolution picks, per entity or per attr. Change
kinds the engine cannot translate (`bm/unsupported-kinds`) make it return
`{:status :unsupported}` so no change is silently dropped. Otherwise it
@ -1239,7 +1240,10 @@
:session-id session-id}))))]
(cond
(seq unresolved)
(audited {:status :conflicts :conflicts conflicts :main-revn (:revn main-file)}
;; `:copies` tells the conflict dialog which copies the
;; integration syncs (`bm/compute-merge`)
(audited {:status :conflicts :conflicts conflicts :copies (:copies merge-summary)
:main-revn (:revn main-file)}
tpoint :merge)
:else
@ -1426,7 +1430,8 @@
(sv/defmethod ::update-branch-from-main
"Bring the changes main received since the merge base into the branch
(the reverse direction of a merge). Returns `{:status :conflicts}` (with
the `:main-revn` they were computed against) when main and the branch
the `:main-revn` they were computed against and the summary's
`:copies`) when main and the branch
diverged on the same entity and it is not resolved in `resolutions`, or
`{:status :unsupported}` for change kinds not yet translatable. On
success it applies main's changes (and any conflicts resolved to main)
@ -1597,7 +1602,8 @@
(cond
(seq unresolved)
(audited {:status :conflicts :conflicts conflicts :main-revn (:revn main-file)}
(audited {:status :conflicts :conflicts conflicts :copies (:copies merge-summary)
:main-revn (:revn main-file)}
tpoint :update-from-main)
(bm/nothing-to-merge? merge-summary excluded)

29
backend/test/backend_tests/branch_copies_follow_component_test.clj
View File

@ -260,7 +260,10 @@
(let [out (merge-branch ctx)]
(t/is (= :conflicts (-> out :result :status)))
(t/is (= #{mi-id} (conflict-ids out))))
(t/is (= #{mi-id} (conflict-ids out)))
(t/testing "the response names the copies the resolution reaches"
(t/is (= [[mi-id 1]] (mapv (juxt :id :copies-affected) (-> out :result :conflicts))))
(t/is (= [#{copy-id}] (mapv #(into #{} (map :id) (:copies %)) (-> out :result :copies))))))
(let [out (merge-branch ctx :resolutions {mi-id side})]
(t/is (nil? (:error out)))
@ -281,7 +284,9 @@
(let [out (update-branch ctx)]
(t/is (= :conflicts (-> out :result :status)))
(t/is (= #{mi-id} (conflict-ids out))))
(t/is (= #{mi-id} (conflict-ids out)))
(t/is (= [[mi-id 1]] (mapv (juxt :id :copies-affected) (-> out :result :conflicts))))
(t/is (= [#{copy-id}] (mapv #(into #{} (map :id) (:copies %)) (-> out :result :copies)))))
(let [out (update-branch ctx :resolutions {mi-id side})]
(t/is (nil? (:error out)))
@ -293,6 +298,26 @@
(t/is (empty? (:touched (shape branch page-id copy-id))))
(t/is (empty? (validation-codes branch)))))))))
(t/deftest the-diff-shows-a-copy-the-rule-settled
;; both sides synced the copy from their own edit of the component:
;; the compare summary shows the copy as settled, following the
;; component, and lists it among the component's copies
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile branch-id comp-id mi-id copy-id] :as ctx} (setup 1)]
(both-edit-component ctx)
(let [out (th/command! {::th/type :get-branch-diff
::rpc/profile-id (:id profile)
:branch-id branch-id})
diff (:result out)
entry (first (filter #(= copy-id (:id %)) (:changes diff)))]
(t/is (nil? (:error out)))
(t/is (= :settled (:status entry)))
(t/is (= {:side :main :reason :follows-component} (get-in entry [:settled :attrs :fills])))
(t/is (= [[mi-id 1]] (mapv (juxt :id :copies-affected) (:conflicts diff))))
(t/is (= [[comp-id mi-id #{copy-id}]]
(mapv (juxt :component-id :main-id #(into #{} (map :id) (:copies %)))
(:copies diff))))))))
;; --- c: one side overrides the copy, the other edits the component
(t/deftest merge-keeps-the-branch-override-of-a-copy

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

@ -379,14 +379,24 @@
(when (and (= :text type) (contains? ctt/attrs-in-text-content token-attr))
:content-group)))
(defn- copy-reason
"Why the copy rule took a side for an attr or token slot no more than
one side overrode: `t?`/`o?` say whether the target/source did. Named
in the comparison roles (`:main` = target), as the sides are."
[t? o?]
(cond o? :override-branch
t? :override-main
:else :follows-component))
(defn- token-slot-sides
"The copy rule over the token attrs (slots) of `:applied-tokens` whose
token differs between `st` and `so`. A side overrode a slot when the
slot's group (`token-slot-group`) is in its `touched` set and its token
moved off the base one. Returns `{:slots {token-attr side}
:open-slots #{token-attr}}`: the rule's side for each slot no more than
one side overrode, and the slots both overrode or that drive no synced
attr."
:slot-reasons {token-attr reason} :open-slots #{token-attr}}`: the
rule's side for each slot no more than one side overrode, why it took
that side (`copy-reason`), and the slots both overrode or that drive
no synced attr."
[type sb st so tt ot]
(let [base-tokens (:applied-tokens sb)
theirs-tokens (:applied-tokens st)
@ -397,11 +407,12 @@
base (get base-tokens slot)
t? (and (some? group) (contains? tt group) (not= base (get theirs-tokens slot)))
o? (and (some? group) (contains? ot group) (not= base (get ours-tokens slot)))]
(cond
(or (nil? group) (and t? o?)) (update acc :open-slots conj slot)
o? (assoc-in acc [:slots slot] :branch)
:else (assoc-in acc [:slots slot] :main))))
{:slots {} :open-slots #{}}
(if (or (nil? group) (and t? o?))
(update acc :open-slots conj slot)
(-> acc
(assoc-in [:slots slot] (if o? :branch :main))
(assoc-in [:slot-reasons slot] (copy-reason t? o?))))))
{:slots {} :slot-reasons {} :open-slots #{}}
(sort-by name (filter #(not= (get theirs-tokens %) (get ours-tokens %))
(set/union (set (keys theirs-tokens)) (set (keys ours-tokens))))))))
@ -411,15 +422,16 @@
classification shapes (stripped, see `strip-shapes`) of the base,
`theirs` and `ours`; `t`/`o` the full ones, which carry `:touched`.
Returns `{:auto {attr side} :open #{attr} :slots {token-attr side}
Returns `{:auto {attr side} :reasons {attr reason} :open #{attr}
:slots {token-attr side} :slot-reasons {token-attr reason}
:open-slots #{token-attr}}` over the attrs that differ between the two
sides: `:auto` holds the side the rule picks for each sync attr no
more than one side overrode (`:main` when none did), and `:open` the
attrs left to the user, the ones both sides overrode and the ones
outside every sync group. `:applied-tokens` is settled per slot
(`token-slot-sides`): it is open while any slot is, the user's side
then deciding the open slots only, and otherwise auto, on `:branch`
when the source wins any slot."
more than one side overrode (`:main` when none did), `:reasons` why
(`copy-reason`), and `:open` the attrs left to the user, the ones both
sides overrode and the ones outside every sync group.
`:applied-tokens` is settled per slot (`token-slot-sides`): it is open
while any slot is, the user's side then deciding the open slots only,
and otherwise auto, on `:branch` when the source wins any slot."
[sb st so t o]
(when (and (some? sb) (some? st) (some? so)
(ctk/in-component-copy? t)
@ -434,8 +446,8 @@
(reduce-kv
(fn [acc attr _]
(if (= :applied-tokens attr)
(let [{:keys [slots open-slots]} (token-slot-sides (:type so) sb st so tt ot)]
(cond-> (assoc acc :slots slots :open-slots open-slots)
(let [{:keys [slots slot-reasons open-slots]} (token-slot-sides (:type so) sb st so tt ot)]
(cond-> (assoc acc :slots slots :slot-reasons slot-reasons :open-slots open-slots)
(seq open-slots)
(update :open conj attr)
@ -444,39 +456,70 @@
(let [group (ctk/resolve-sync-group (:type so) attr)
t? (and (some? group) (overrode? group tt sb st attr))
o? (and (some? group) (overrode? group ot sb so attr))]
(cond
(or (nil? group) (and t? o?)) (update acc :open conj attr)
o? (assoc-in acc [:auto attr] :branch)
:else (assoc-in acc [:auto attr] :main)))))
{:auto {} :open #{} :slots {} :open-slots #{}}
(if (or (nil? group) (and t? o?))
(update acc :open conj attr)
(-> acc
(assoc-in [:auto attr] (if o? :branch :main))
(assoc-in [:reasons attr] (copy-reason t? o?)))))))
{:auto {} :reasons {} :open #{} :slots {} :slot-reasons {} :open-slots #{}}
(shallow-attr-diff st so))))))
(defn- settled-sides
"The `:settled` map of a summary entry for a copy the rule settled
(`sides`, see `copy-conflict-sides`): each attr and token slot the
rule decided, with its side and reason, and what the user still
decides. `:applied-tokens` is reported through its slots only, and
is among `:open-attrs` exactly when some slot is open. Named in the
comparison roles; `doc-sides` renames it."
[{:keys [auto reasons open slots slot-reasons open-slots]}]
{:attrs (into {}
(keep (fn [[attr side]]
(when (not= :applied-tokens attr)
[attr {:side side :reason (get reasons attr)}])))
auto)
:token-slots (into {}
(map (fn [[slot side]]
[slot {:side side :reason (get slot-reasons slot)}]))
slots)
:open-attrs open
:open-token-slots open-slots})
(defn- settle-copy-conflicts
"Apply the copy rule to the `:modify-modify` shape conflicts of one
page's comparison `res`. A conflict whose attrs the rule settles
entirely leaves `:conflicts`; it comes back as a `:modified` change
over the attrs the source wins, if any, since the merge applies them.
A conflict with open attrs stays, its `:changed-attrs` narrowed to
them: the merge applies the settled ones whatever the user picks."
over the attrs the source wins, if any, since the merge applies them,
and as a `:settled` entry otherwise, which applies nothing and only
shows what the rule decided. A conflict with open attrs stays, its
`:changed-attrs` narrowed to them: the merge applies the settled ones
whatever the user picks. Every entry the rule touched carries
`:settled` (`settled-sides`)."
[{:keys [conflicts] :as res} sbo sto soo to oo]
(reduce
(fn [acc {:keys [id reason changed-attrs] :as c}]
(if-let [{:keys [auto open]} (when (= :modify-modify reason)
(copy-conflict-sides (get sbo id) (get sto id) (get soo id)
(get to id) (get oo id)))]
(let [won (into [] (keep (fn [[attr side]] (when (= :branch side) attr))) auto)]
(if-let [{:keys [auto open] :as sides}
(when (= :modify-modify reason)
(copy-conflict-sides (get sbo id) (get sto id) (get soo id)
(get to id) (get oo id)))]
(let [won (into [] (keep (fn [[attr side]] (when (= :branch side) attr))) auto)
settled (settled-sides sides)
change (fn [status attrs]
(-> c
(dissoc :reason :base :main :branch)
(assoc :status status
:changed-attrs (select-keys changed-attrs attrs)
:settled settled)))]
(cond
(seq open)
(update acc :conflicts conj (assoc c :changed-attrs (select-keys changed-attrs open)))
(update acc :conflicts conj (assoc c
:changed-attrs (select-keys changed-attrs open)
:settled settled))
(seq won)
(update acc :changes conj (-> c
(dissoc :reason :base :main :branch)
(assoc :status :modified
:changed-attrs (select-keys changed-attrs won))))
(update acc :changes conj (change :modified won))
:else
acc))
(update acc :changes conj (change :settled (keys changed-attrs)))))
(update acc :conflicts conj c)))
(assoc res :conflicts [])
conflicts))
@ -1474,6 +1517,22 @@
(transient {})
(or index {}))))
(def ^:private flip-doc
"The other document, for a side or a copy rule reason named after one;
anything else (`:open`, `:follows-component`) names none."
{:main :branch
:branch :main
:override-main :override-branch
:override-branch :override-main})
(defn- flip-decision
"A copy rule decision `{:side .. :reason ..}` named after the other
document."
[decision]
(-> decision
(update :side #(get flip-doc % %))
(update :reason #(get flip-doc % %))))
(defn- doc-sides
"Rewrite one summary entry from the comparison roles to the documents.
@ -1482,16 +1541,22 @@
`:main->branch` the engine runs with those roles fed the other way round
(so the reported changes are main's), and this renames the payload back
before `compute-merge` reports it: the two entity sides, the two values
inside every `:changed-attrs` pair, and the two delete reasons.
inside every `:changed-attrs` pair, the two delete reasons, and the
sides and reasons of the copy rule's `:settled` decisions.
`:delete-modify` names the branch's deletion against main's modification
and `:modify-delete` the branch's modification against main's deletion —
the same meaning in both directions."
[{:keys [status changed-attrs] :as entry}]
[{:keys [status changed-attrs settled] :as entry}]
(let [entry (cond-> entry
(map? changed-attrs)
(assoc :changed-attrs
(into {} (map (fn [[k v]] [k {:main (:branch v) :branch (:main v)}]))
changed-attrs)))]
changed-attrs))
(some? settled)
(assoc :settled (-> settled
(update :attrs update-vals flip-decision)
(update :token-slots update-vals flip-decision))))]
(if (= :conflict status)
(-> entry
(assoc :main (:branch entry) :branch (:main entry))
@ -1546,6 +1611,264 @@
(cond-> (assoc entry :key (change-key entry))
(some? owner) (merge owner))))
;; --- Copies of the components the source changes ---
;;
;; The summary says, for every local component whose main the source
;; changes, which copies the target holds after the integration and how
;; each will take the change: `sync-copies` runs after integrating, and
;; a copy follows the merged component except in the sync groups and
;; token slots it overrides (see "Component copies" above). Derived from
;; the three documents only: nothing here runs the sync. Named in the
;; comparison roles; `doc-copies` renames them.
(defn- main-shape-changes
"What the source changed on one shape of a component's main, base `b`
against source `o`: `{:groups #{group} :slots #{token-attr}}`, the
sync groups whose attrs moved (`:shapes-group` for its children, as
the sync names them) and the token slots whose token did, or nil when
the change moves nothing a copy syncs."
[b o]
(when (and (some? b) (some? o) (not= b o))
(let [b (strip-nil-attrs b)
o (strip-nil-attrs o)
{:keys [groups slots] :as res}
(reduce-kv
(fn [acc attr _]
(case attr
:shapes
(update acc :groups conj :shapes-group)
:applied-tokens
(let [bt (:applied-tokens b) ot (:applied-tokens o)]
(update acc :slots into
(filter #(not= (get bt %) (get ot %)))
(set/union (set (keys bt)) (set (keys ot)))))
(if-let [group (ctk/resolve-sync-group (:type o) attr)]
(update acc :groups conj group)
acc)))
{:groups #{} :slots #{}}
(shallow-attr-diff b o))]
(when (or (seq groups) (seq slots))
res))))
(defn- component-main-changes
"`{main-shape-id changes}` (`main-shape-changes`) over the main of
`component` the source `ours` changed against `base`, or nil when the
source changed nothing a copy syncs. A main the base lacks is new, and
no copy of it predates the change."
[base ours {:keys [main-instance-id main-instance-page]}]
(let [bo (get-in base [:pages-index main-instance-page :objects])
oo (get-in ours [:pages-index main-instance-page :objects])]
(when (and (contains? bo main-instance-id)
(contains? oo main-instance-id)
(not (identical? bo oo)))
(not-empty
(into {}
(keep (fn [id]
(when-let [changes (main-shape-changes (get bo id) (get oo id))]
[id changes])))
(subtree-ids oo main-instance-id))))))
(defn- copy-heads
"`{component-id [[page-id head-id] ..]}`: the copies of `component-ids`
the target holds after the integration, those either side has minus
the ones either side deleted, nested copies included. Outside the
pages `keep?` admits, `ours` equals `base` (see `compute-merge`), so
the base stands in for it."
[base theirs ours keep? component-ids]
(let [objects (fn [data pid] (get-in data [:pages-index pid :objects]))
pages (into (set (keys (:pages-index theirs)))
(filter keep?)
(keys (:pages-index ours)))]
(reduce
(fn [acc pid]
(let [bo (objects base pid)
to (objects theirs pid)
oo (if (keep? pid) (objects ours pid) bo)
head? (fn [shape]
(and (contains? component-ids (:component-id shape))
(not (ctk/main-instance? shape))))
kept? (fn [id]
(not (and (contains? bo id)
(or (not (contains? to id)) (not (contains? oo id))))))]
(reduce (fn [acc shape]
(let [id (:id shape)]
(if (and (head? shape) (kept? id))
(update acc (:component-id shape) (fnil conj #{}) [pid id])
acc)))
acc
(concat (vals to) (when-not (identical? oo to) (vals oo))))))
{}
pages)))
(defn- override-rank
"Precedence of a copy's token slot decision when shapes of the copy
decide it differently: an open slot over an override over following."
[{:keys [side reason]}]
(cond (= :open side) 2
(= :follows-component reason) 0
:else 1))
(defn- copy-summary
"How the copy `head` of page `pid` takes the source's change to its
component, whose main shapes `changes` maps (`component-main-changes`)
and whose main shape ids are `main-ids`. Each shape of the copy pairs
with the main shape its `:shape-ref` chain reaches (`lookup` resolves
a ref on any page), and per changed sync group or token slot of that
main shape it follows the component unless a side's copy shape has
the group touched. When both sides have it touched, the side whose
value the integration keeps holds the override: the source's when it
changed the copy shape, the target's otherwise. A group can be both
followed and kept when the copy's shapes differ; a token slot takes
the strongest decision (`override-rank`). `::followed` holds the
`[main-shape-id group-or-slot]` pairs the copy follows, which
`with-copies-affected` reads and the summary leaves out."
[lookup main-ids changes pid head bo to oo]
(let [main-of (fn [shape]
(loop [ref (:shape-ref shape) n 8]
(cond
(nil? ref) nil
(contains? main-ids ref) ref
(pos? n) (recur (:shape-ref (lookup ref)) (dec n))
:else nil)))
shape (or (get oo head) (get to head))
ids (distinct (concat (when (contains? oo head) (subtree-ids oo head))
(when (contains? to head) (subtree-ids to head))))
res
(reduce
(fn [acc id]
(let [ts (get to id)
os (get oo id)
s (or os ts)
m (main-of s)
{:keys [groups slots]} (get changes m)
tt (set (:touched ts))
ot (set (:touched os))
both (fn [] (if (and (some? os) (not= (strip-nil-attrs (get bo id))
(strip-nil-attrs os)))
:branch
:main))
acc (reduce
(fn [acc group]
(let [t? (contains? tt group) o? (contains? ot group)]
(if (or t? o?)
(update acc :keeps #(if (contains? % group)
%
(assoc % group (cond (and t? o?) (both) o? :branch :else :main))))
(-> acc
(update :follows conj group)
(update ::followed conj [m group])))))
acc
(sort groups))]
(reduce
(fn [acc slot]
(let [group (token-slot-group (:type s) slot)
t? (and (some? group) (contains? tt group))
o? (and (some? group) (contains? ot group))
decision (if (and t? o?)
{:side :open :reason :override-both}
{:side (if o? :branch :main) :reason (copy-reason t? o?)})]
(cond-> (update acc :token-slots
#(let [prev (get % slot)]
(if (and (some? prev) (>= (override-rank prev) (override-rank decision)))
%
(assoc % slot decision))))
(and (not t?) (not o?))
(update ::followed conj [m slot]))))
acc
(sort-by name slots))))
{:follows #{} :keeps {} :token-slots {} ::followed #{}}
ids)]
(assoc res
:id head
:page-id pid
:label (entity-label :shape shape))))
(defn- component-copies
"The `:copies` of the summary: one entry per local component whose
main the source `ours` changes against `base` in a way a copy syncs,
with every copy the target holds after the integration and how it
takes the change (`copy-summary`). Bounded to the pages `only-pages`
admits for the source's changes, as the page passes are; the copies
are looked up on every page. Ordered by component name, then id."
[base theirs ours only-pages]
(let [keep? (if (some? only-pages) #(contains? only-pages %) (constantly true))
changed (into {}
(keep (fn [component]
(when (keep? (:main-instance-page component))
(when-let [changes (component-main-changes base ours component)]
[(:id component) [component changes]]))))
(ctkl/components-seq ours))]
(when (seq changed)
(let [heads (copy-heads base theirs ours keep? (set (keys changed)))
lookup (fn [id]
(some (fn [data]
(some #(get-in % [:objects id]) (vals (:pages-index data))))
[ours theirs base]))
objs (fn [data pid] (get-in data [:pages-index pid :objects]))]
(->> changed
(map (fn [[cid [{cname :name :keys [main-instance-id main-instance-page]} changes]]]
(let [main-ids (set (subtree-ids (objs ours main-instance-page) main-instance-id))]
{:component-id cid
:component-name cname
:main-id main-instance-id
:main-page-id main-instance-page
:copies (->> (get heads cid)
(map (fn [[pid head]]
(let [bo (objs base pid)]
(copy-summary lookup main-ids changes pid head bo
(objs theirs pid)
(if (keep? pid) (objs ours pid) bo)))))
(sort-by (juxt :label (comp str :id)))
(vec))})))
(sort-by (juxt :component-name (comp str :component-id)))
(vec))))))
(defn- doc-copies
"One `:copies` entry (`component-copies`) named after the documents
rather than the comparison roles (see `doc-sides`)."
[entry]
(update entry :copies
(partial mapv (fn [copy]
(-> copy
(update :keeps update-vals flip-doc)
(update :token-slots update-vals flip-decision))))))
(defn- conflict-sync-keys
"The sync groups and token slots the `:changed-attrs` of a shape
conflict drive: what a copy following the shape takes from the
conflict's resolution."
[{:keys [shape-type changed-attrs]}]
(into #{}
(mapcat (fn [[attr {:keys [main branch]}]]
(case attr
:shapes [:shapes-group]
:applied-tokens (filter #(not= (get main %) (get branch %))
(set/union (set (keys main)) (set (keys branch))))
(some-> (ctk/resolve-sync-group shape-type attr) vector))))
changed-attrs))
(defn- with-copies-affected
"A decorated conflict (`decorate-entry`) on a shape of a component's
main, its main instance or a shape inside it, with the number of the
component's copies `copies` (`component-copies`) lists that follow
the shape in a sync group or token slot the conflict drives
(`conflict-sync-keys`): the copies its resolution reaches through the
sync. A copy keeping an override of every one of them, on either
side, is not reached."
[copies {:keys [kind id component-id] :as entry}]
(if (and (= :shape kind) (some? component-id))
(let [driven (conflict-sync-keys entry)
reached? (fn [copy] (some #(contains? driven (second %))
(filter #(= id (first %)) (::followed copy))))]
(assoc entry :copies-affected
(or (some #(when (= component-id (:component-id %))
(count (filter reached? (:copies %))))
copies)
0)))
entry))
(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
@ -1592,13 +1915,21 @@
;; 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])
;; the copies the integration syncs, named after the documents
;; like the entries
copies (cond->> (or (component-copies base theirs ours only-pages) [])
update? (mapv doc-copies))
changes (mapv decorate changes)
conflicts (mapv decorate conflicts)]
conflicts (mapv (comp (partial with-copies-affected copies) decorate) conflicts)]
{:changes changes
:conflicts conflicts
:copies (mapv (fn [entry]
(update entry :copies (partial mapv #(dissoc % ::followed))))
copies)
;; the tree-shape policies act per direction (`tree-modes`), so
;; `compute-changes` needs to know which one this summary is
:dir dir
;; a `:settled` entry is no change: it counts nowhere
:stats {:added (count (filterv #(= :added (:status %)) changes))
:modified (count (filterv #(= :modified (:status %)) changes))
:deleted (count (filterv #(= :deleted (:status %)) changes))
@ -1610,7 +1941,8 @@
{:changes [<change descriptor> ...] ; clean, branch -> main
:conflicts [<conflict descriptor> ...] ; need resolution
:stats {:added n :modified n :deleted n :conflicts n}}
:stats {:added n :modified n :deleted n :conflicts n}
:copies [<component copies> ...]}
Every entry names the two DOCUMENTS, whatever `dir`: `:main` carries
main's value, `:branch` the branch's, and each `:changed-attrs` pair
@ -1641,11 +1973,50 @@
in the conflict, whole, while any token attr is open. A copy the rule
settles entirely leaves `:conflicts`, and comes back as a `:modified`
change over the attrs the source overrode, which the merge takes from
it."
it, or as a `:settled` entry when the source overrode none. Every
entry the rule touched carries `:settled`:
{:attrs {attr {:side s :reason r}}
:token-slots {token-attr {:side s :reason r}}
:open-attrs #{attr} ; the user's choice decides these
:open-token-slots #{token-attr}}
with `r` one of `:follows-component` (no side overrode it: the target
keeps its value until the sync sets the component's, so `s` names the
target), `:override-main` and `:override-branch`. `:applied-tokens`
shows through its slots, and is among `:open-attrs` exactly when a
slot is open. A `:settled` entry applies nothing: it counts
in no `:stats`, `compute-changes` and `nothing-to-merge?` ignore it,
and excluding it excludes nothing (`settled?`).
`:copies` lists, per local component whose main the source changes in
a way a copy syncs, the copies the target holds after the integration
and how each takes the change, ordered by component name:
{:component-id id :component-name n :main-id id :main-page-id id
:copies [{:id id :page-id id :label l
:follows #{group} ; take the merged component's
:keeps {group side} ; keep an override
:token-slots {token-attr {:side s :reason r}}}]}
A token slot that follows the component names the target as its side,
as in `:settled`; one both sides override has side `:open`, reason
`:override-both`. A conflict on a shape of a component's main (its
main instance or a shape inside it) carries `:copies-affected`, the
number of the component's listed copies that follow that shape in a
sync group or token slot the conflict's attrs drive: a copy keeping
its override there, on either side, does not take the resolution."
([base main branch dir] (compute-merge* base main branch dir nil))
([base main branch dir {:keys [only-pages]}]
(compute-merge* base main branch dir only-pages)))
(defn settled?
"True for a summary entry that only shows a copy the copy rule settled
entirely (`:status :settled`): it applies nothing, so no count, gate
or selection treats it as a change."
[entry]
(= :settled (:status entry)))
(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
@ -1654,7 +2025,7 @@
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))]
(let [entries (remove settled? (concat (:changes merge-summary) (:conflicts merge-summary)))]
(and (seq entries)
(every? #(contains? excluded (change-key %)) entries))))
@ -2275,11 +2646,19 @@
([base main branch resolutions merge-summary excluded]
(let [merge-summary (or merge-summary (compute-merge base main branch :branch->main))
resolutions (or resolutions {})
excluded (or excluded #{})
;; a `:settled` entry applies nothing, so excluding it excludes
;; nothing: its key names a copy the rule decides whatever the
;; selection says
excluded (into #{}
(remove (into #{}
(comp (filter settled?) (map change-key))
(:changes merge-summary)))
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 settled?)
(remove #(contains? excluded (change-key %)))
(unsupported-kinds))

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

@ -11,6 +11,7 @@
[app.common.files.changes-builder :as pcb]
[app.common.files.tokens :as cfo]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
@ -1930,7 +1931,10 @@
branch (mkdata {:k (copy-shape "green")})
r (bm/compute-merge base main branch :branch->main)]
(t/is (empty? (:conflicts r)))
(t/is (empty? (:changes r)))
(t/is (= [[:k :settled {:attrs {:fills {:side :main :reason :follows-component}}
:token-slots {} :open-attrs #{} :open-token-slots #{}}]]
(mapv (juxt :id :status :settled) (:changes r))))
(t/is (= {:added 0 :modified 0 :deleted 0 :conflicts 0} (:stats r)))
(t/is (empty? (copy-ops (:changes (bm/compute-changes base main branch {} r)))))))
(t/deftest copy-attr-the-source-overrode-wins
@ -1954,7 +1958,8 @@
branch (mkdata {:k (copy-shape "green")})
r (bm/compute-merge base main branch :branch->main)]
(t/is (empty? (:conflicts r)))
(t/is (empty? (:changes r)))
(t/is (= [[:k :settled {:fills {:side :main :reason :override-main}}]]
(mapv (juxt :id :status (comp :attrs :settled)) (:changes r))))
(t/is (empty? (copy-ops (:changes (bm/compute-changes base main branch {} r)))))))
(t/deftest copy-attr-both-sides-overrode-is-a-conflict
@ -2036,7 +2041,8 @@
branch (mkdata {:k (tokens-copy {:fill "green"})})
r (bm/compute-merge base main branch :branch->main)]
(t/is (empty? (:conflicts r)))
(t/is (empty? (:changes r)))
(t/is (= [[:k :settled {:fill {:side :main :reason :follows-component}}]]
(mapv (juxt :id :status (comp :token-slots :settled)) (:changes r))))
(t/is (empty? (copy-ops (:changes (bm/compute-changes base main branch {} r)))))))
(t/deftest copy-token-slots-settle-one-at-a-time
@ -2112,3 +2118,134 @@
(t/is (= #{(thi/id :component1)} scope))
(t/is (= "#fabada" (tho/bottom-fill-color synced :nested2-head)))
(t/is (= "#fabada" (tho/bottom-fill-color synced :copy2-root)))))))
;; --- the summary shows what the copy rule decides ---
(defn- component-with-copy
[]
(-> (thf/sample-file :file1)
(tho/add-simple-component-with-copy :c1 :main-root :main-child :copy1)))
(defn- copies-of
"The copies the summary `r` lists for its one component, by id."
[r]
(into {}
(map (fn [copy] [(:id copy) (select-keys copy [:follows :keeps :token-slots])]))
(:copies (first (:copies r)))))
(t/deftest copies-list-a-copy-the-other-side-added-as-following
;; the branch edits the component, main adds a second copy: both
;; copies follow the merged component's fill
(thi/test-fixture
(fn []
(let [file (component-with-copy)
branch (tho/update-color file :main-child "#00ff00")
main (thc/instantiate-component file :c1 :copy2)
r (bm/compute-merge (:data file) (:data main) (:data branch) :branch->main)]
(t/is (= [{:component-id (thi/id :c1) :main-id (thi/id :main-root)}]
(mapv #(select-keys % [:component-id :main-id]) (:copies r))))
(t/is (= {(thi/id :copy1) {:follows #{:fill-group} :keeps {} :token-slots {}}
(thi/id :copy2) {:follows #{:fill-group} :keeps {} :token-slots {}}}
(copies-of r)))))))
(t/deftest copies-show-the-override-one-side-keeps
(thi/test-fixture
(fn []
(let [file (component-with-copy)
edited (tho/update-color file :main-child "#00ff00")
override (tho/update-bottom-color file :copy1 "#ff0000")]
(t/testing "merging: the branch edits the component, main overrides the copy"
(let [r (bm/compute-merge (:data file) (:data override) (:data edited) :branch->main)]
(t/is (= {(thi/id :copy1) {:follows #{} :keeps {:fill-group :main} :token-slots {}}}
(copies-of r)))))
(t/testing "updating: main edits the component, the branch overrides the copy"
(let [r (bm/compute-merge (:data file) (:data edited) (:data override) :main->branch)]
(t/is (= {(thi/id :copy1) {:follows #{} :keeps {:fill-group :branch} :token-slots {}}}
(copies-of r)))))))))
(t/deftest a-conflict-on-a-main-counts-the-copies-it-affects
(thi/test-fixture
(fn []
(let [file (component-with-copy)]
(doseq [label [:main-root :main-child]]
(t/testing (name label)
(let [main (tho/update-color file label "#0000ff")
branch (tho/update-color file label "#00ff00")
r (bm/compute-merge (:data file) (:data main) (:data branch) :branch->main)]
(t/is (= [[(thi/id label) 1]]
(mapv (juxt :id :copies-affected) (:conflicts r)))))))
(t/testing "a copy keeping its override of the conflict's group is not affected"
;; main overrides copy1's child fill; copy2 follows everything
(let [base (thc/instantiate-component file :c1 :copy2)]
(doseq [[label affected] [[:main-child 1] [:main-root 2]]]
(t/testing (name label)
(let [main (-> base
(tho/update-bottom-color :copy1 "#ff0000")
(tho/update-color label "#0000ff"))
branch (tho/update-color base label "#00ff00")
r (bm/compute-merge (:data base) (:data main) (:data branch) :branch->main)]
(t/is (= [[(thi/id label) affected]]
(mapv (juxt :id :copies-affected) (:conflicts r)))))))))
(t/testing "no copy follows the conflict's group: none is affected"
(let [main (-> file
(tho/update-bottom-color :copy1 "#ff0000")
(tho/update-color :main-child "#0000ff"))
branch (tho/update-color file :main-child "#00ff00")
r (bm/compute-merge (:data file) (:data main) (:data branch) :branch->main)]
(t/is (= [[(thi/id :main-child) 0]]
(mapv (juxt :id :copies-affected) (:conflicts r))))))))))
(t/deftest a-settled-copy-shows-and-applies-nothing
;; both sides synced K from their own edit of the component, and the
;; branch edited S
(let [base (mkdata {:k (copy-shape "red") :s {:id :s :name "S" :fill "red"}})
main (mkdata {:k (copy-shape "blue") :s {:id :s :name "S" :fill "red"}})
branch (mkdata {:k (copy-shape "green") :s {:id :s :name "S" :fill "blue"}})
r (bm/compute-merge base main branch :branch->main)
settled (filterv bm/settled? (:changes r))
k-key (:key (first settled))
s-key (:key (first (remove bm/settled? (:changes r))))
unshown (update r :changes #(filterv (complement bm/settled?) %))
changes (:changes (bm/compute-changes base main branch {} r))]
(t/is (= [[:k :settled]] (mapv (juxt :id :status) settled)))
(t/is (= {:added 0 :modified 1 :deleted 0 :conflicts 0} (:stats r)))
(t/testing "compute-changes ignores it, excluded or not"
(t/is (= changes (:changes (bm/compute-changes base main branch {} unshown))))
(t/is (= changes (:changes (bm/compute-changes base main branch {} r #{k-key})))))
(t/testing "nothing-to-merge? ignores it"
(t/is (not (bm/nothing-to-merge? r #{k-key})))
(t/is (true? (bm/nothing-to-merge? r #{s-key}))))))
(t/deftest a-partly-settled-copy-conflict-names-what-stays-open
(t/testing "attrs: both override the fill, only the branch the opacity"
(let [base (mkdata {:k (copy-shape "red" :opacity 1)})
main (mkdata {:k (copy-shape "blue" :opacity 1 :touched #{:fill-group})})
branch (mkdata {:k (copy-shape "green" :opacity 0.5
:touched #{:fill-group :layer-effects-group})})
r (bm/compute-merge base main branch :branch->main)]
(t/is (= {:attrs {:opacity {:side :branch :reason :override-branch}}
:token-slots {}
:open-attrs #{:fills}
:open-token-slots #{}}
(:settled (first (:conflicts r)))))))
(t/testing "token slots: both apply a fill token, only the branch a radius one"
(let [base (mkdata {:k (tokens-copy {})})
main (mkdata {:k (tokens-copy {:fill "yellow"} :touched #{:fill-group})})
branch (mkdata {:k (tokens-copy {:fill "red" :r1 "round"}
:touched #{:fill-group :radius-group})})
r (bm/compute-merge base main branch :branch->main)]
(t/is (= {:attrs {}
:token-slots {:r1 {:side :branch :reason :override-branch}}
:open-attrs #{:applied-tokens :fills}
:open-token-slots #{:fill}}
(:settled (first (:conflicts r)))))))
(t/testing "updating from main, the sides name the documents"
(let [base (mkdata {:k (tokens-copy {})})
main (mkdata {:k (tokens-copy {:fill "red"} :touched #{:fill-group})})
branch (mkdata {:k (tokens-copy {:fill "green"})})
r (bm/compute-merge base main branch :main->branch)]
(t/is (= [[:k :modified {:attrs {:fills {:side :main :reason :override-main}}
:token-slots {:fill {:side :main :reason :override-main}}
:open-attrs #{}
:open-token-slots #{}}]]
(mapv (juxt :id :status :settled) (:changes r)))))))