From 65a80857be2b234b608248f0611fa233b8119094 Mon Sep 17 00:00:00 2001 From: Your Name Date: Tue, 7 Jul 2026 13:07:49 -0400 Subject: [PATCH] feat: :in membership edges replace transclusion/mark-home placement MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Placement is now asserted, not derived. An annotation carries :in — an ordered vector of the mark-groups it's filed under (first = primary home, scene/home). Membership decides listing; mark resolution independently decides whether bars draw. Marks are never moved or re-cut. Rebuilt from the clean pre-transclusion base, keeping only the codex frame-integer (assert-frame) work: - delete ref-owner / mark-home / mark-homes / :home-marks / rehome-marks - annotations drop :parent entirely; restore-annotations migrates legacy :parent -> :in [parent]; :in is a vector (JSON-round-trips like :tags/:notes) - file-edge (shared by ::reparent drag + ::file-into picker): move vs add/link; ::unfile guards primary + last; files-under? cycle guard - ::associate-marks no longer auto-files (adding marks != placement) - root identified by (= :timeline (:type)), not (nil? :parent) - membership-chips `in:` row; drag ⌥ = link; .reference cards Tests: real day8.re-frame.test run-test-sync suite driving events + live subscriptions (pane, context, reveal, reparent, associate, unfile, cycle, JSON wire). 62 tests / 243 assertions, 0 failures; 0 residue. Co-Authored-By: Claude Opus 4.8 --- tl/resources/public/css/app.css | 16 ++ tl/shadow-cljs.edn | 1 + tl/src/tl/events.cljs | 188 +++++++++--------- tl/src/tl/scene.cljs | 121 +++++------- tl/src/tl/subs.cljs | 36 ++-- tl/src/tl/views.cljs | 65 +++++- tl/test/tl/flow_test.cljs | 339 +++++++++++++++----------------- tl/test/tl/scene_test.cljs | 111 +++++------ 8 files changed, 447 insertions(+), 430 deletions(-) diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index e34fcc0..e5058b7 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -333,6 +333,22 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px; .ann-tags .tag { font-size: 9px; padding: 0 6px 0 12px; line-height: 1.6; border-radius: 2px 8px 8px 2px; } .ann-tags .tag::before { width: 3px; height: 3px; left: 5px; } +/* the `in:` membership row — where this annotation is filed (:in edges) */ +.ann-in { display: flex; flex-wrap: wrap; align-items: center; gap: 4px; margin-top: 5px; } +.ann-in-label { font-size: 9px; color: var(--muted, #888); text-transform: uppercase; letter-spacing: .04em; } +.in-chip { display: inline-flex; align-items: center; gap: 2px; font-size: 9px; + padding: 0 5px; line-height: 1.7; background: var(--shade); color: var(--ink); + border: 1px solid var(--ink); border-radius: 8px; cursor: pointer; } +.in-chip:hover { background: var(--ink); color: var(--paper); } +.in-x, .in-plus { font-size: 9px; line-height: 1; padding: 0 1px; background: none; + border: none; color: inherit; cursor: pointer; opacity: .6; } +.in-x:hover, .in-plus:hover { opacity: 1; } +.in-plus { border: 1px dashed var(--ink); border-radius: 8px; padding: 0 5px; line-height: 1.6; opacity: .7; } +.in-add-pop { display: inline-flex; align-items: center; gap: 2px; } +.in-add-pop .ac { min-width: 140px; } +/* a card filed here whose footage doesn't land here — reference only, no bars */ +.ann.reference { border-style: dashed; opacity: .78; } + /* reveal-children toggle at the card bottom + the nested child cards */ .show-children { display: block; width: 100%; margin-top: 8px; padding: 3px 6px; font-family: var(--chicago); font-size: 11px; text-align: left; diff --git a/tl/shadow-cljs.edn b/tl/shadow-cljs.edn index 5209343..c4a87c1 100644 --- a/tl/shadow-cljs.edn +++ b/tl/shadow-cljs.edn @@ -9,6 +9,7 @@ [re-frame "1.4.7"] [metosin/reitit "0.9.1"] [day8.re-frame/http-fx "0.2.4"] + [day8.re-frame/test "0.1.5"] [binaryage/devtools "1.0.7"]] :dev-http diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 6035ef1..e5773f5 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -463,7 +463,7 @@ (defn- draft-in-ctx [db ctx] (some (fn [[gid g]] - (when (and (:draft g) (= ctx (:parent g))) [gid g])) + (when (and (:draft g) (= ctx (scene/home (:scene db) gid))) [gid g])) (get-in db [:scene :groups]))) (defn- draft-mark-at [db ctx lf] @@ -489,7 +489,7 @@ (defn- mark-start-local [db ann mark-id] (let [scene (:scene db) - ctx (:parent (get-in scene [:groups ann])) + ctx (scene/home scene ann) segs (scene/content-segments scene ctx)] (ffirst (scene/mark-bars scene ann mark-id segs)))) @@ -499,7 +499,7 @@ (let [[ann _] (or (draft-in-ctx db (peek (get-in db [:view :stack]))) (some (fn [[gid g]] (when (:draft g) [gid g])) (get-in db [:scene :groups]))) - ctx (:parent (get-in db [:scene :groups ann])) + ctx (scene/home (:scene db) ann) local (when ann (mark-start-local db ann mark-id)) db (cond-> db ann (start-drawing-db ann mark-id) @@ -657,9 +657,10 @@ ;; uuid, not gensym: gensym's counter resets each page load, so a ;; fresh annotation would reuse a prior gid and clobber it on merge. (assoc-in [:scene :groups (keyword (str "ann-" (random-uuid)))] - {:type :annotation :parent (peek (get-in db [:view :stack])) - :draft :new :name "" :color "#4e8fc2" :marks [] - :v scene/schema-version}) + (let [ctx (peek (get-in db [:view :stack]))] + {:type :annotation :in [ctx] ; filed under the context it's born in + :draft :new :name "" :color "#4e8fc2" :marks [] + :v scene/schema-version})) (assoc-in [:view :pt] :new) (assoc-in [:view :active-mark] nil) (assoc-in [:view :draft-stage] :choosing)))) @@ -674,28 +675,28 @@ (rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit) (assoc-in [:view :pt] :new)))) -;; Edit an annotation from a card. If its parent timeline is not the timeline -;; currently being viewed, enter that parent first so mark rows/handles edit in -;; their authored coordinate system. finish-edit pops this temporary parent. +;; Edit an annotation from a card. If its primary home isn't the context being +;; viewed, enter that home first so mark rows/handles edit in their authored +;; coordinate system. finish-edit pops this temporary context. (rf/reg-event-fx ::edit-annotation (fn [{:keys [db]} [_ gid]] - (let [parent (get-in db [:scene :groups gid :parent]) + (let [home (scene/home (:scene db) gid) ctx (peek (get-in db [:view :stack])) - push-parent? (and parent (not= parent ctx)) - fx (if push-parent? (enter-ctx db #(conj % parent)) {:db db})] + push-home? (and home (not= home ctx)) + fx (if push-home? (enter-ctx db #(conj % home)) {:db db})] (update fx :db #(cond-> (-> % (assoc-in [:scene :groups gid :draft] :edit) (assoc-in [:view :pt] :new) (assoc-in [:view :edit-pop-parent] nil)) - push-parent? (assoc-in [:view :edit-pop-parent] parent)))))) + push-home? (assoc-in [:view :edit-pop-parent] home)))))) ;; Edit the annotation you're currently inside: drop into its parent timeline so ;; its marks are editable there, remembering to pop back when done. Root has no ;; parent (and no marks) — edit it in place. (rf/reg-event-fx ::edit-here (fn [{:keys [db]} [_ gid]] - (let [root? (nil? (get-in db [:scene :groups gid :parent])) + (let [root? (= :timeline (get-in db [:scene :groups gid :type])) fx (if root? {:db db} (enter-ctx db pop))] (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit) (assoc-in [:view :pt] :new) @@ -730,7 +731,7 @@ (let [g (cond-> (editable-group g) (= :annotation (:type g)) (assoc :v scene/schema-version)) patch (group-patch orig g) - root? (nil? (:parent g)) ; the root timeline persists whole + root? (= :timeline (:type g)) ; the root timeline persists whole id (get-in db [:project :id]) ; (no diff: it'd lose :type/:marks) ;; proxies this annotation references are synthetic clips in the pool — ;; persist them alongside it or the {:ref proxy} marks dangle on reload. @@ -752,18 +753,24 @@ id (assoc :http-xhrio (api/put-scene id {:deleted [gid]} {:on-success [::scene-saved] :on-failure [::save-error]})))))) -;; --- move an annotation into another context (drag-drop reparent) --------- -;; Drag/drop re-expresses the annotation's visible mark coverage in the target -;; context. The parent is just where the annotation is edited/listed; the marks -;; still decide what actually renders by resolving down to clips and intersecting -;; the target timeline. -(defn- descendant? - "Is `gid` equal to `anc` or somewhere below it in the :parent tree?" - [scene anc gid] - (loop [g gid] - (cond (nil? g) false - (= g anc) true - :else (recur (get-in scene [:groups g :parent]))))) +;; --- membership edges (:in): file an annotation under mark-groups ---------- +;; Placement is ASSERTED, not derived. `:in` is an ORDERED vector of the mark-groups +;; the annotation is filed under; the FIRST is the primary home (scene/home) — where +;; it's edited and its links resolve. Marks never move or re-cut — they resolve to +;; raw clips globally, and that only decides whether BARS draw in a context. Three +;; gestures, each editing ONE edge (O(1), retroactive): move (drag), add (⌥-drag / +;; file-into picker), remove (× on a chip). + +(defn- files-under? + "Does `desc` reach `anc` by following :in edges (would nesting create a cycle)?" + [scene desc anc seen] + (boolean + (when-not (contains? seen desc) + (let [ins (scene/membership scene desc)] + (or (contains? ins anc) + (some #(and (= :annotation (get-in scene [:groups % :type])) + (files-under? scene % anc (conj seen desc))) + ins)))))) (rf/reg-event-db ::ann-drag-start @@ -779,64 +786,62 @@ (assoc-in [:view :dragging-ann] nil) (assoc-in [:view :dragging-ann-source] nil)))) -(defn- rehome-marks - [scene gid source-parent new-parent] - (let [target-segs (scene/content-segments scene new-parent)] - (reduce (fn [{:keys [marks proxies]} m] - (if (= source-parent (scene/mark-home scene m)) - (let [bare (dissoc m :home-marks) - history (:home-marks m {}) - history (assoc history source-parent bare)] - (if-let [saved (get history new-parent)] - {:marks (conj marks (assoc saved :home-marks (dissoc history new-parent))) - :proxies proxies} - (let [bars (scene/mark-bars scene gid (:id m) target-segs)] - (if (seq bars) - (let [pid (keyword (str "prox-" (random-uuid))) - proxy {:type :proxy :parent nil - :marks (mapv identity - (mapcat (fn [[lo hi]] - (scene/selection->marks scene new-parent lo hi)) - bars))} - m* (assoc (merge m (scene/proxy-ref (:id m) pid)) - :home-marks history)] - {:marks (conj marks m*) :proxies (assoc proxies pid proxy)}) - {:marks (conj marks m) :proxies proxies})))) - {:marks (conj marks m) :proxies proxies})) - {:marks [] :proxies {}} - (get-in scene [:groups gid :marks])))) +(defn- persist-group + "fx map that stores annotation `gid` = `g*` locally and (if online) pushes just + the changed fields to the backend." + [db gid orig g*] + (let [id (get-in db [:project :id]) + patch (group-patch orig g*)] + (cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) (assoc :save-error nil))} + (and id (seq patch)) + (assoc :http-xhrio (api/put-scene id {:changed {gid patch}} + {:on-success [::scene-saved] + :on-failure [::save-error]}))))) -(defn- has-home? [scene gid source-parent] - (some #(= source-parent (scene/mark-home scene %)) - (get-in scene [:groups gid :marks]))) +;; The one edge edit both drag-drop and the file-into picker share. `add?` keeps +;; existing edges (link); otherwise the edge you grabbed is moved off its source. +;; Marks are untouched either way. +(defn- file-edge [db gid new-parent add? source] + (let [scene (:scene db) + g (get-in scene [:groups gid]) + in (vec (:in g)) + clear #(-> % (assoc-in [:view :dragging-ann] nil) + (assoc-in [:view :dragging-ann-source] nil))] + (if (or (not= :annotation (:type g)) ; only annotations file + (:draft g) ; not mid-draft + (= gid new-parent) ; not under itself + (contains? (set in) new-parent) ; already filed there + (files-under? scene new-parent gid #{})) ; would make a cycle + {:db (clear db)} + (let [in' (if add? + (conj in new-parent) ; link: append, primary unchanged + (let [rest* (vec (remove #{source} in))] + (if (= source (first in)) + (into [new-parent] rest*) ; moved the primary → new home + (conj rest* new-parent)))) + g* (assoc g :in in')] + (update (persist-group db gid g g*) :db clear))))) (rf/reg-event-fx ::reparent - (fn [{:keys [db]} [_ gid new-parent]] - (let [scene (:scene db) - g (get-in scene [:groups gid]) - source-parent (or (get-in db [:view :dragging-ann-source]) - (peek (get-in db [:view :stack])))] - (if (or (not= :annotation (:type g)) ; only annotations move - (:draft g) ; not while being drafted/edited - (= source-parent new-parent) - (not (has-home? scene gid source-parent)) - (descendant? scene gid new-parent)) ; target inside gid -> cycle - {:db (-> db - (assoc-in [:view :dragging-ann] nil) - (assoc-in [:view :dragging-ann-source] nil))} - (let [id (get-in db [:project :id]) - {:keys [marks proxies]} (rehome-marks scene gid source-parent new-parent) - g* (assoc g :parent new-parent :marks marks) - patch (editable-group g*)] - (cond-> {:db (-> db (assoc-in [:scene :groups gid] g*) - (update-in [:scene :groups] merge proxies) - (assoc-in [:view :dragging-ann] nil) - (assoc-in [:view :dragging-ann-source] nil) - (assoc :save-error nil))} - id (assoc :http-xhrio (api/put-scene id {:changed (merge {gid patch} proxies)} - {:on-success [::scene-saved] - :on-failure [::save-error]})))))))) + (fn [{:keys [db]} [_ gid new-parent add?]] + (let [source (or (get-in db [:view :dragging-ann-source]) (peek (get-in db [:view :stack])))] + (file-edge db gid new-parent add? source)))) + +;; file into a group chosen from the picker — always additive (source nil). +(rf/reg-event-fx ::file-into + (fn [{:keys [db]} [_ gid target]] + (file-edge db gid target true nil))) + +;; remove one membership edge (× on a chip). Never the primary home, never the last. +(rf/reg-event-fx + ::unfile + (fn [{:keys [db]} [_ gid target]] + (let [g (get-in db [:scene :groups gid]) + in (vec (:in g))] + (if (or (= target (first in)) (not (some #{target} in)) (<= (count in) 1)) + {:db db} + (persist-group db gid g (assoc g :in (vec (remove #{target} in)))))))) (rf/reg-event-db ::scene-saved (fn [db _] (assoc db :save-error nil))) (rf/reg-event-db ::save-error @@ -870,7 +875,7 @@ ::unset-proxy-endpoint (fn [db [_ gid mark-id pid which]] (let [scene (:scene db) - ctx (:parent (get-in scene [:groups gid])) + ctx (scene/home scene gid) segs (scene/content-segments scene ctx) [lo hi] (scene/mark-extent scene gid mark-id segs)] (assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)})))) @@ -880,14 +885,14 @@ ;; seek to its start, and drop into drawing mode ("select a range → you're drawing"). (defn- select-range-fx [db gid g lo hi] (let [scene (:scene db) - p (scene/make-proxy scene (:parent g) lo hi) + p (scene/make-proxy scene (scene/home scene gid) lo hi) pgid (keyword (str "prox-" (random-uuid))) mid (str (random-uuid)) - sf (scene/local->source (scene/content-segments scene (:parent g)) lo)] + sf (scene/local->source (scene/content-segments scene (scene/home scene gid)) lo)] {:db (-> db (assoc-in [:scene :groups pgid] p) (update-in [:scene :groups gid :marks] conj (scene/proxy-ref mid pgid)) (assoc-in [:view :active-mark] mid) - (assoc-in [:view :playheads (:parent g)] lo) + (assoc-in [:view :playheads (scene/home scene gid)] lo) (assoc-in [:view :pt] :new)) :player/seek (when sf (/ sf (:fps db))) :fx [[:dispatch [::start-drawing gid mid]]]})) @@ -906,7 +911,7 @@ (fn [{:keys [db]} [_ seg-id frame]] (let [scene (:scene db) [gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups scene)) - segs (scene/content-segments scene (:parent g)) + segs (scene/content-segments scene (scene/home scene gid)) pt (get-in db [:view :pt])] (cond ;; re-picking one endpoint of a proxy: roll only that side, keep the other @@ -919,7 +924,7 @@ lo (scene/assert-frame "proxy range start" (min new-local keep)) hi (scene/assert-frame "proxy range end" (max new-local keep))] {:db (-> db (assoc-in [:scene :groups (:proxy pt)] - (scene/roll-proxy scene (:parent g) proxy lo (max (inc lo) hi))) + (scene/roll-proxy scene (scene/home scene gid) proxy lo (max (inc lo) hi))) (assoc-in [:view :pt] :new))}) (map? pt) @@ -931,7 +936,7 @@ ;; re-picking an endpoint: reconcile-run keeps the mark id for the ;; piece on the kept clip; re-attach that mark's bindings, and splice ;; the run back into its original slot so order is preserved. - (let [run (->> (scene/reconcile-run scene (:parent g) [old] lo hi) + (let [run (->> (scene/reconcile-run scene (scene/home scene gid) [old] lo hi) (mapv (fn [m] (if (= (:id m) (:id old)) (cond-> m (:notes old) (assoc :notes (:notes old)) @@ -1006,9 +1011,10 @@ (fn [{:keys [db]} [_ draft-gid target-gid]] (let [marks (get-in db [:scene :groups draft-gid :marks]) orig-t (get-in db [:scene :groups target-gid]) - target (-> orig-t - (update :marks (fnil into []) marks) - (dissoc :home)) + ;; adding marks does NOT change placement — membership is asserted, never + ;; derived from where marks were authored. To also list C in this context, + ;; file it in explicitly (the ＋ picker / drag). + target (update orig-t :marks (fnil into []) marks) patch (group-patch orig-t target) ; just the :marks change proxies (into {} (keep (fn [m] (let [pid (get-in m [:start :ref]) pg (get-in db [:scene :groups pid])] diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 133a0c8..a8fc6cd 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -120,7 +120,7 @@ ;; --- resolution ---------------------------------------------------------- -(declare resolve resolve-mark) +(declare resolve resolve-mark home child-of?) (defn- target-segs "Resolved segments (local 0-based) of a referenceable id: a group (clip, @@ -168,7 +168,7 @@ [scene gid point] (cond (number? point) - (let [parent (:parent (grp scene gid))] + (let [parent (home scene gid)] {:frame (if parent (local->source (resolve scene parent) point) point) :track nil}) @@ -219,7 +219,7 @@ lb (at->l (:at end))] (when (and (<= 0 la len) (<= 0 lb len) (<= la lb)) (rebase id (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb)))))) - (let [parent (:parent (grp scene gid))] + (let [parent (home scene gid)] (if parent ; absolute, relative to parent (rebase id (slice (resolve scene parent) start end)) [{:mark id :track track :src [start end] :local [0 (- end start)] @@ -365,71 +365,45 @@ (when (seq pcs) [(reduce min (map first pcs)) (reduce max (map second pcs))]))) -(defn clip-loss? - "True when annotation `gid` loses any content once clipped to its immediate - parent annotation — it references frames outside the parent timeline, so it's - (partly) out of range there. Timeline/root parents contain everything." +;; --- placement: :in membership edges -------------------------------------- +;; Placement is ASSERTED, not derived. An annotation carries `:in` — an ordered +;; vector of the mark-groups it's FILED UNDER. ONE field, ONE concept: filed under +;; a timeline/act ⇒ lists in that pane; filed under another annotation ⇒ nests in +;; it. The FIRST element is the primary home (where its :content links resolve and +;; where it's edited); the whole vector as a set is its membership. Marks are never +;; moved or re-cut — they resolve to raw clips globally, and that only decides +;; whether BARS draw in a context (footage ∩ ctx). It's a vector (not a set) so it +;; round-trips through JSON exactly like :tags/:notes, and order fixes a primary. + +(defn home + "The primary home of `gid`: the first `:in` edge for an annotation (where its + description links resolve and where it's edited); the structural `:parent` for + anything else (nil for the flat clip/proxy pool and the root timeline)." [scene gid] - (let [p (:parent (grp scene gid))] + (let [g (grp scene gid)] + (if (= :annotation (:type g)) (first (:in g)) (:parent g)))) + +(defn membership + "The set of mark-groups annotation `gid` is filed under (its `:in` edges)." + [scene gid] + (set (:in (grp scene gid)))) + +(defn child-of? + "Is annotation `gid` filed under `ctx`?" + [scene ctx gid] + (contains? (membership scene gid) ctx)) + +(defn clip-loss? + "True when annotation `gid` loses content once clipped to its primary home — it + references frames outside that parent annotation, so it's (partly) out of range + there. Timeline/root homes contain everything, so they never warn." + [scene gid] + (let [p (home scene gid)] (when (and p (= :annotation (:type (grp scene p)))) (let [len (fn [rs] (reduce + (map (fn [[a b]] (- b a)) rs))) own (mapv :src (resolve scene gid))] (< (len (src-intersect own (mapv :src (resolve scene p)))) (len own)))))) -;; --- reference parent: which timeline a mark was authored in --------------- -;; A mark's proxy DIRECTLY references a content unit of exactly one timeline — the -;; one it was authored in. That timeline is the mark's "home"; the annotation -;; holding the mark shows as a child there. This is one hop (a direct reference), -;; NOT transitive resolution down to clips — so a grandchild is a child of its -;; parent, not of the root. An annotation that collected marks from two contexts -;; (transclusion) is a child of both. This is the "fk" the nesting rides on. - -(defn- ref-owner - "The timeline that OWNS content unit `t`: :root for a clip, else the annotation - whose proxy contains the mark `t` (t is one of that annotation's content units). - nil if `t` dangles." - [scene t] - (cond - (= :clip (:type (grp scene t))) :root - (find-mark scene t) - (let [[container _] (find-mark scene t)] - (if (= :proxy (:type (grp scene container))) - (some (fn [[gid g]] - (when (and (= :annotation (:type g)) - (some #(= container (get-in % [:start :ref])) (:marks g))) - gid)) - (:groups scene)) - container)) - :else nil)) - -(defn mark-home - "The timeline mark `m` was authored in — the owner of the content unit its proxy - DIRECTLY references (one hop). :root for a clip-backed mark. The annotation that - holds `m` shows as a child of this timeline. nil if unresolvable." - [scene m] - (let [pid (get-in m [:start :ref]) - t (if (= :proxy (:type (grp scene pid))) - (get-in (first (:marks (grp scene pid))) [:start :ref]) - pid)] - (ref-owner scene t))) - -(defn mark-homes - "The distinct timelines annotation `gid`'s marks are homed in — its reference - parent(s). Usually one; two (or more) when it collected marks from different - contexts (transclusion). Falls back to the structural `:parent` when the - annotation has no resolvable marks (a fresh draft, a fully broken one), so it - still shows somewhere." - [scene gid] - (let [g (grp scene gid) - homes (into #{} (keep #(mark-home scene %)) (:marks g))] - (if (seq homes) homes #{(:parent g)}))) - -(defn child-of? - "Is annotation `gid` a direct child of timeline `ctx` — a mark of its authored - there (homed in ctx)." - [scene ctx gid] - (contains? (mark-homes scene gid) ctx)) - ;; --- editing: split a local selection into a run of single-clip marks ----- (defn selection->marks @@ -520,12 +494,7 @@ (get-in m [:end :ref]) (update-in [:end :ref] keyword) (:track m) (update :track keyword) (:notes m) (update :notes #(mapv keyword %)) ; bound script-note gids - (:drawings m) (update :drawings #(mapv keyword %)) ; bound drawing gids - (:home-marks m) (update :home-marks - (fn [homes] - (into {} (map (fn [[home mark]] - [(keyword home) (restore-mark mark)])) - homes))))) + (:drawings m) (update :drawings #(mapv keyword %)))) ; bound drawing gids (defn- restore-region "A script-note region loses keyword-ness through JSON: re-keyword :id and :kind." @@ -568,9 +537,15 @@ :proxy (update g :marks #(mapv restore-mark (or % []))) ; synthetic clip: just its run :drawing g ; pure strokes + seed, JSON round-trips as-is (-> g + (dissoc :parent) ; annotations are placed by :in alone (update :marks #(mapv restore-mark (or % []))) (cond-> (:notes g) (update :notes #(mapv keyword %))) ; annotation-level bindings + ;; membership edges: keyword an existing :in vector, + ;; or seed one from a legacy single :parent + (assoc :in (if-let [in (:in g)] + (mapv keyword in) + (when (:parent g) [(:parent g)]))) migrate))]))) anns)) @@ -744,7 +719,7 @@ (sort-by (comp first :local) segs))})))) anns (->> (:groups scene) (keep (fn [[gid g]] - (when (and (= :annotation (:type g)) (= ctx (:parent g)) + (when (and (= :annotation (:type g)) (child-of? scene ctx gid) (not (:draft g))) {:name (or (:name g) (name gid)) :kind :annotation :items (mapv (fn [{:keys [id lo len]}] @@ -754,14 +729,14 @@ (vec (concat (sort-by :name tracks) (sort-by :name anns))))) (defn path-to - "Stack path from :root down to `gid` following :parent links, or nil if an - ancestor is missing — an orphan whose parent context was deleted." + "Stack path from :root down to `gid` following primary-home links, or nil if an + ancestor is missing — an orphan whose home context was deleted." [scene gid] (loop [g gid, acc ()] (cond (= g :root) (vec (cons :root acc)) (or (nil? g) (not (contains? (:groups scene) g))) nil - :else (recur (get-in scene [:groups g :parent]) (cons g acc))))) + :else (recur (home scene g) (cons g acc))))) (defn timelines "Every reachable timeline you can open as a context — root, plus named child @@ -773,7 +748,7 @@ (keep (fn [[gid g]] (when (and (= :annotation (:type g)) (not (:draft g))) (when-let [path (path-to scene gid)] - (let [parent (:parent g)] + (let [parent (home scene gid)] {:gid gid :name (or (:name g) (name gid)) :in (if (or (nil? parent) (= :root parent)) "root" (get-in scene [:groups parent :name] (name parent))) diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index cce6113..00861c6 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -135,15 +135,15 @@ :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed] (fn [[scene ctx segs revealed] _] (let [ann? (fn [gid] (= :annotation (:type (get-in scene [:groups gid])))) - ;; each annotation → its reference PARENTS: the timeline(s) its marks were - ;; authored in (mark-homes). A normal annotation has one; a transcluded one - ;; (marks from two contexts) has two, so it shows as a child under BOTH. + ;; each annotation → the mark-groups it's FILED UNDER (:in membership). A + ;; normal annotation has one; a linked one has several, so it lists under + ;; each. Asserted, not derived from where marks resolve. parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))] - [gid (scene/mark-homes scene gid)])) + [gid (scene/membership scene gid)])) ;; child count per timeline (drives the "Show N" nested badge) nested (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents)) - ;; reference-reveal hierarchy: shows when ctx is a reference parent, or a - ;; REVEALED reference-parent that itself shows. `seen` guards ref cycles. + ;; membership-reveal hierarchy: shows when ctx is a host it's filed under, + ;; or a REVEALED host annotation that itself shows. `seen` guards cycles. shown? (fn shown? [gid seen] (and (not (contains? seen gid)) (boolean (some (fn [p] (or (= ctx p) @@ -152,20 +152,13 @@ (->> (:groups scene) (keep (fn [[gid g]] (when (= :annotation (:type g)) - ;; VISIBILITY IS BY REFERENCE: an annotation shows in ctx when a - ;; mark of its was AUTHORED in ctx (homed there) — one hop, not - ;; transitive — so a mark made in ctx shows even if the annotation - ;; is parented elsewhere (transclusion), while a grandchild does - ;; not leak up and a sibling covering the same clips stays out. + ;; VISIBILITY IS BY MEMBERSHIP (:in): an annotation shows in ctx + ;; iff it's filed under ctx, or under a revealed host that itself + ;; shows. Where its marks resolve only decides whether bars draw. (let [bars (scene/lane-bars scene gid segs)] ; one bar per mark; distinct marks never fuse (when (shown? gid #{}) (let [reason (scene/broken-reason scene gid) - ;; clip-loss compares against the structural :parent. - ;; A transcluded annotation is intentionally authored in - ;; multiple reference parents, so judging all marks - ;; against only :parent creates a false warning. - oor (boolean (and (= (parents gid) #{(:parent g)}) - (scene/clip-loss? scene gid))) + oor (boolean (scene/clip-loss? scene gid)) hidden (get-in g [:meta :hidden]) note-ids (->> (concat (:notes g) (mapcat :notes (:marks g))) distinct @@ -186,10 +179,9 @@ (get-in cg [:media :name]) (some-> ref name))))) distinct)] - {:id gid :parent (:parent g) - ;; the timeline(s) this annotation is a child of (mark-homes) — - ;; the pane groups by this so a transcluded annotation appears - ;; under every context it was authored in. + {:id gid :parent (scene/home scene gid) ; primary home = first :in + ;; the mark-groups this annotation is filed under (:in) — the + ;; pane groups by this, so a linked annotation lists under each. :parents (parents gid) :name (:name g) :color (or (:color g) "#4e8fc2") :content (:content g) :children (count (:marks g)) @@ -281,7 +273,7 @@ (fn [[gid g]] ;; child annotations of the context OR the context annotation itself ;; (pushing the owner onto the stack makes ctx that annotation) - (when (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid))) + (when (and (= :annotation (:type g)) (or (scene/child-of? scene ctx gid) (= ctx gid))) (let [src-segs (scene/resolve scene gid) by-mark (group-by :mark src-segs) ->bars (fn [ss] (scene/merge-bars diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 05e1b47..e0e785e 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -1138,6 +1138,54 @@ [:span.tag t (when on-remove [:button.tag-x {:type "button" :title "Remove tag" :on-click #(on-remove t)} "✕"])]) +(defn- group-name [scene gid] + (if (or (nil? gid) (= :root gid)) + "root" + (let [g (get-in scene [:groups gid])] + (or (:name g) (get-in g [:media :name]) (some-> gid name))))) + +;; The `in:` row — every mark-group this annotation is FILED UNDER (:in). Click a +;; chip to go there; ✕ un-files it (never its primary home). ＋ opens a picker to +;; file into any other group (annotation or timeline/act), at any nesting depth — +;; that's the "link across arbitrarily nested groups" gesture (search, not drag). +(defn- membership-chips [scene a authed?] + (r/with-let [adding? (r/atom false)] + (let [gid (:id a) + homes (:parents a) + prim (:parent a) + cands (->> (:groups scene) + (keep (fn [[g grp]] + (when (and (contains? #{:annotation :timeline} (:type grp)) + (not= g gid) + (not (contains? homes g))) + {:gid g :label (group-name scene g)}))) + (sort-by :label))] + [:div.ann-in + [:span.ann-in-label "in:"] + (for [h (sort homes)] + ^{:key (str h)} + [:span.in-chip {:title (str "Go to " (group-name scene h)) + :on-click #(rf/dispatch (if (= h :root) + [::events/pop-to :root] + [::events/expand h]))} + (group-name scene h) + (when (and authed? (not= h prim)) + [:button.in-x {:type "button" :title "Un-file" + :on-click (fn [e] (.stopPropagation e) + (rf/dispatch [::events/unfile gid h]))} "✕"])]) + (when authed? + (if @adding? + [:span.in-add-pop + [autocomplete {:items (mapv :label cands) :placeholder "file into…" + :auto-focus? true + :on-choose (fn [label] + (when-let [c (some #(when (= label (:label %)) %) cands)] + (rf/dispatch [::events/file-into gid (:gid c)])) + (reset! adding? false))}] + [:button.in-x {:type "button" :on-click #(reset! adding? false)} "✕"]] + [:button.in-plus {:type "button" :title "File into another group" + :on-click #(reset! adding? true)} "＋"]))]))) + (defn- link-picker [{:keys [scene ctx on-commit on-cancel]}] (r/with-let [picked (r/atom nil)] [:div.mark-block.pending.link-insert-block @@ -1221,19 +1269,25 @@ (when (has-type? e "text/ann") (.stopPropagation e) (.preventDefault e) (reset! over? true))) :on-drag-leave (fn [_] (reset! over? false)) + ;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS + ;; (links, keeping the old home) — file-manager convention. :on-drop (fn [e] (let [src (.. e -dataTransfer (getData "text/ann"))] (when (seq src) (.stopPropagation e) (.preventDefault e) (reset! over? false) - (rf/dispatch [::events/reparent (keyword src) (:id a)]))))})) + (rf/dispatch [::events/reparent (keyword src) (:id a) (.-altKey e)]))))})) (defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen] (r/with-let [over? (r/atom false) hov? (r/atom false)] (let [active? @(rf/subscribe [::subs/annotation-active? (:id a)]) dragging @(rf/subscribe [::subs/dragging-ann]) drop-ok? (and dragging (not= dragging (:id a))) + ;; filed here but its footage doesn't land in this context → a reference + ;; card: listed for organisation, no bars to draw. Jump still works. + reference? (and (not (:draft a)) (empty? (:bars a))) drag-props (merge (ann-drag-props a authed? over? source-parent) {:class (str (when active? "active ") + (when reference? "reference ") (when (and drop-ok? @over?) "drop-over ") (when drop-ok? "drop-ready"))})] (if (:hidden a) @@ -1273,6 +1327,7 @@ [:button.del-btn {:title "Delete" :on-click #(when (js/confirm (str "Delete \"" (:name a) "\"?")) (rf/dispatch [::events/delete-annotation (:id a)]))} "✕"])]] + [membership-chips scene a authed?] (when (not-empty (:content a)) [content-display scene ctx (:content a)]) (when (seq (:notes a)) [:div.ann-notes @@ -1310,7 +1365,7 @@ (when (scene/clip-loss? scene ctx) [:span.ann-warn {:title "Out of range — this annotation references frames its parent timeline trims"} "⚠ "]) (if (seq (:content cg)) - [content-display scene (or (:parent cg) ctx) (:content cg)] + [content-display scene (or (scene/home scene ctx) ctx) (:content cg)] [:div.muted "No description yet."]) (when authed? [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])]) @@ -1484,14 +1539,14 @@ scene @(rf/subscribe [::subs/scene]) ;; anchor the form to the draft's home context, not the live stack top: ;; a link-insert timeline preview moves the stack, but this annotation - ;; still belongs to (:parent d), so its marks/pickers stay stable. - ctx (or (:parent d) (:gid d)) ; annotation: its parent; root: itself + ;; still belongs to its primary home (first :in), so pickers stay stable. + ctx (or (first (:in d)) (:gid d)) ; annotation: its home; root: itself segs (scene/content-segments scene ctx) pt @(rf/subscribe [::subs/pt]) linking @(rf/subscribe [::subs/linking]) gid (:gid d) new? (= :new (:draft d)) - root? (nil? (:parent d)) + root? (= :timeline (:type d)) ;; ONE shared form for new + edit. In draft/new we HIDE the lower fields ;; (content, notes, save) until a title is picked — pick a new title to ;; "create new", or an existing annotation to "edit existing". The title diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs index a39101b..8412ce5 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -1,9 +1,15 @@ (ns tl.flow-test - "Integration tests that drive the ACTUAL re-frame events the UI dispatches - (dispatch-sync) and read the resulting app-db / scene back — so a bug that lives - in an event handler (not a pure scene fn) is caught. Side-effecting fx are - stubbed so the sync path stays pure; project id is nil so nothing hits the net." + "Integration tests that drive the ACTUAL re-frame events the UI dispatches and + read the resulting scene AND live subscriptions back — via day8.re-frame.test's + run-test-sync, so subscriptions resolve in a real reactive context (no 'outside + reactive context' warnings) and dispatch is synchronous. A bug that lives in an + event handler or a subscription (not just a pure scene fn) is caught here. + + Placement model under test: an annotation's `:in` is an ordered vector of the + mark-groups it's FILED UNDER (first = primary home). Membership is asserted; + where marks resolve only decides whether bars draw. See tl.scene/membership." (:require [cljs.test :refer-macros [deftest is testing]] + [day8.re-frame.test :as rf-test] [re-frame.core :as rf] [re-frame.db :as rdb] [tl.events :as ev] @@ -16,8 +22,7 @@ :connect-scene :fetch-projects :poll-thumbnails :upload-project]] (rf/reg-fx k (fn [_] nil))) -;; single-source footage: four clips, ALL named "Challengers.mov" (this is why the -;; media name is useless as a label — the track+occurrence is what distinguishes) +;; four clips on four tracks, one shared source file; root spans [0,400) (def clips-scene {:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}} :groups {:root {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]} @@ -27,19 +32,19 @@ :clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}}) (defn seed - "clips + annA (over clips A,B) + annB (over clips C,D) + annC (parented under A, - holding one mark authored inside A) — the state right before you drill into B." + "clips + annA (over clips A,B, filed under root) + annB (over C,D, filed under + root) + annC (one mark authored inside annA, FILED under annA)." [] (let [pA (s/make-proxy clips-scene :root 0 200) pB (s/make-proxy clips-scene :root 200 400) sc (-> clips-scene (assoc-in [:groups :pA] pA) (assoc-in [:groups :pB] pB) - (assoc-in [:groups :annA] {:type :annotation :parent :root :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]}) - (assoc-in [:groups :annB] {:type :annotation :parent :root :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]})) + (assoc-in [:groups :annA] {:type :annotation :in [:root] :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]}) + (assoc-in [:groups :annB] {:type :annotation :in [:root] :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]})) pInA (s/make-proxy sc :annA 10 60)] (-> sc (assoc-in [:groups :pInA] pInA) - (assoc-in [:groups :annC] {:type :annotation :parent :annA :name "C" :color "#00f" + (assoc-in [:groups :annC] {:type :annotation :in [:annA] :name "C" :color "#00f" :marks [(s/proxy-ref "ca" :pInA)]})))) (defn setup! [scene stack] @@ -48,185 +53,155 @@ :project {:id nil}})) (defn scene* [] (:scene @rdb/app-db)) -(defn bars-in [ctx gid] - (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) +(defn draft-gid [] (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))) +(defn pane-ids + "The set of annotation gids the pane sub currently lists (in the live context)." + [] + (set (map :id @(rf/subscribe [::subs/all-annotations])))) +(defn card [gid] (some #(when (= gid (:id %)) %) @(rf/subscribe [::subs/all-annotations]))) +(defn bars-in [ctx gid] (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx))) -(deftest editing-nested-annotation-temporarily-enters-parent - (testing "card edit pushes the parent timeline, and finish-edit pops it back" - (setup! (seed) [:root]) - (rf/dispatch-sync [::ev/edit-annotation :annC]) - (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))) - (is (= :edit (get-in (scene*) [:groups :annC :draft]))) - (is (= :annA (get-in @rdb/app-db [:view :edit-pop-parent]))) - (rf/dispatch-sync [::ev/finish-edit]) - (is (= [:root] (get-in @rdb/app-db [:view :stack]))) - (is (nil? (get-in @rdb/app-db [:view :edit-pop-parent])))) - (testing "editing from the parent context does not push a duplicate parent" - (setup! (seed) [:root :annA]) - (rf/dispatch-sync [::ev/edit-annotation :annC]) - (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))) - (is (nil? (get-in @rdb/app-db [:view :edit-pop-parent]))) - (rf/dispatch-sync [::ev/finish-edit]) - (is (= [:root :annA] (get-in @rdb/app-db [:view :stack]))))) +;; ========================================================================= +;; the annotation pane sub (::all-annotations) lists by membership +;; ========================================================================= -(deftest dragging-transcluded-annotation-to-root-rehomes-it - (testing "drag/drop root owns placement even when marks were authored under two annotations" - (setup! (seed) [:root]) - (rf/dispatch-sync [::ev/expand :annB]) - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 50 150]) - (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))] - (rf/dispatch-sync [::ev/associate-marks draft-gid :annC])) - (rf/dispatch-sync [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil]) - (rf/dispatch-sync [::ev/finish-edit]) - (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) - (let [original-b-mark (second (get-in (scene*) [:groups :annC :marks]))] - (rf/dispatch-sync [::ev/reparent :annC :root]) - (is (= :root (get-in (scene*) [:groups :annC :parent]))) - (is (nil? (get-in (scene*) [:groups :annC :home]))) - (is (= #{:annA :root} (s/mark-homes (scene*) :annC))) - (is (= [:annA :root] - (mapv #(s/mark-home (scene*) %) - (get-in (scene*) [:groups :annC :marks])))) - (is (s/child-of? (scene*) :root :annC)) - (is (s/child-of? (scene*) :annA :annC)) - (is (not (s/child-of? (scene*) :annB :annC))) - (rf/dispatch-sync [::ev/collapse]) - (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))] - (is (contains? ids :annC))) - (rf/dispatch-sync [::ev/reparent :annC :annB]) - (let [restored-b-mark (second (get-in (scene*) [:groups :annC :marks]))] - (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) - (is (= original-b-mark (dissoc restored-b-mark :home-marks))) - (is (contains? (:home-marks restored-b-mark) :root)) - (is (not (s/child-of? (scene*) :root :annC))) - (is (s/child-of? (scene*) :annB :annC)))))) +(deftest pane-lists-strictly-by-membership + (rf-test/run-test-sync + (setup! (seed) [:root]) + (testing "at root: annA and annB (filed under root) show; annC (filed under annA) does NOT" + (is (= #{:annA :annB} (pane-ids))) + (is (= :root @(rf/subscribe [::subs/context]))) + (is (= #{:root} (:parents (card :annA))) "card carries its :in membership (annA is filed under root)")) + (testing "pushing annA onto the stack lists annC (its child), not annA/annB" + (rf/dispatch [::ev/expand :annA]) + (is (= [:root :annA] (:stack (:view @rdb/app-db)))) + (is (= :annA @(rf/subscribe [::subs/context]))) + (is (contains? (pane-ids) :annC)) + (is (not (contains? (pane-ids) :annB)))) + (testing "collapsing returns to root's listing" + (rf/dispatch [::ev/collapse]) + (is (= #{:annA :annB} (pane-ids)))))) -(deftest tie-marks-to-annotation-in-another-context-then-drag - (testing "author a range while drilled into annB, tie it to annC (parented under - annA), then drag its handle — it must stay one proxy, stay visible in - annB, and NOT vanish when rerolled." - (setup! (seed) [:root]) - ;; drill into annB (real stack-nav event) - (rf/dispatch-sync [::ev/expand :annB]) - (is (= [:root :annB] (get-in @rdb/app-db [:view :stack]))) - ;; new draft + select a range 50..150 (C-tail + D-head), exactly as a lane drag - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 50 150]) - (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))] - (is draft-gid "a draft should exist after open-draft") - (is (= 1 (count (get-in (scene*) [:groups draft-gid :marks]))) "one proxy mark, not per-clip") - ;; tie the draft's marks to the existing annC (transclusion) - (rf/dispatch-sync [::ev/associate-marks draft-gid :annC]) - (let [annC (get-in (scene*) [:groups :annC]) - bmk (last (:marks annC)) - bid (:id bmk)] - (is (nil? (get-in (scene*) [:groups draft-gid])) "draft is consumed") - (is (= 2 (count (:marks annC))) "annC now has its A-mark + the new B-mark") - (is (= :proxy (:type (get-in (scene*) [:groups (get-in bmk [:start :ref])]))) - "the tied mark is a single proxy-ref, not expanded into per-clip marks") +;; ========================================================================= +;; reparent — drag MOVE and ⌥ ADD edit exactly one :in edge; marks untouched +;; ========================================================================= - ;; BUG 1 — labels. Viewed from annB: the new B-mark's endpoint is one of - ;; annB's own content units (labels via the context), while annC's A-mark is - ;; foreign here. Its fallback must be the TRACK ("A-roll"), never the shared - ;; source-file name "Challengers.mov". - (let [ctx-ids (into #{} (map :mark) (s/content-segments (scene*) :annB)) - row-seg (fn [gid-mark] (get-in (s/mark-row (scene*) gid-mark) [:s :seg])) - amk (first (:marks annC))] ; the A-mark - (is (contains? ctx-ids (row-seg bmk)) "B-mark endpoint is one of annB's units → context-labelled") - (is (not (contains? ctx-ids (row-seg amk))) "A-mark is foreign in annB") - (is (= "A-roll" (s/ref-track-name (scene*) (row-seg amk))) "foreign label is the track, not Challengers.mov") - (is (not= "Challengers.mov" (s/ref-track-name (scene*) (row-seg amk))))) +(deftest reparent-move-then-link + (rf-test/run-test-sync + (setup! (seed) [:root]) + (let [marks0 (get-in (scene*) [:groups :annC :marks])] + (testing "drag annC (grabbed under annA) onto root: the edge MOVES, primary follows" + (rf/dispatch [::ev/ann-drag-start :annC :annA]) + (rf/dispatch [::ev/reparent :annC :root]) ; add? falsey ⇒ move + (is (= [:root] (:in (get-in (scene*) [:groups :annC])))) + (is (= :root (s/home (scene*) :annC))) + (is (= marks0 (get-in (scene*) [:groups :annC :marks])) "marks untouched by a move")) + (testing "now annC lists at root and no longer under annA" + (setup! (assoc-in (scene*) [:view] {:stack [:root] :playheads {} :revealed #{} :zoom 1 :row-h 20}) [:root]) + (is (contains? (pane-ids) :annC)) + (rf/dispatch [::ev/expand :annA]) + (is (not (contains? (pane-ids) :annC)))) + (testing "⌥-drag (add?) links annC under annB WITHOUT removing root" + (rf/dispatch [::ev/collapse]) + (rf/dispatch [::ev/ann-drag-start :annC :root]) + (rf/dispatch [::ev/reparent :annC :annB true]) + (is (= #{:root :annB} (s/membership (scene*) :annC))) + (is (= :root (s/home (scene*) :annC)) "primary home unchanged by a link") + (is (= marks0 (get-in (scene*) [:groups :annC :marks]))))))) - ;; REFERENCE PARENTS — annC is a child of A (its A-mark) and B (its B-mark), - ;; and NOT of root (it's a grandchild there: one hop, not transitive to clips) - (is (= #{:annA :annB} (s/mark-homes (scene*) :annC))) - (is (s/child-of? (scene*) :annB :annC)) - (is (not (s/child-of? (scene*) :root :annC))) +(deftest reparent-refuses-cycles-and-noops + (rf-test/run-test-sync + (setup! (seed) [:root]) + (testing "filing annA under annC (which is filed under annA) is refused — a cycle" + (rf/dispatch [::ev/file-into :annA :annC]) + (is (not (contains? (s/membership (scene*) :annA) :annC)))) + (testing "filing under a group it's already filed under is a no-op" + (let [before (:in (get-in (scene*) [:groups :annC]))] + (rf/dispatch [::ev/file-into :annC :annA]) + (is (= before (:in (get-in (scene*) [:groups :annC])))))) + (testing "an annotation can't be filed under itself" + (rf/dispatch [::ev/file-into :annC :annC]) + (is (not (contains? (s/membership (scene*) :annC) :annC)))))) - ;; LANE in annB: exactly one bar for annC's B-mark - (is (= 1 (count (bars-in :annB :annC))) "annC shows exactly one bar in annB") - (is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2))) +;; ========================================================================= +;; unfile — remove one edge; never the primary home, never the last +;; ========================================================================= - ;; ISSUE 1 — the PANE LIST (::all-annotations, grouped by :parents) must - ;; include annC under annB, and must not pull in non-children. - (let [anns @(rf/subscribe [::subs/all-annotations]) - c (some #(when (= :annC (:id %)) %) anns) - under (fn [p] (->> anns (filter #(contains? (:parents %) p)) (map :id) set))] - (is c "annC is present in ::all-annotations while viewing annB") - (is (contains? (:parents c) :annB) "annC's reference parents include annB") - (is (false? (:oor c)) "transclusion is not out-of-range just because its structural parent is elsewhere") - (is (false? (:broken c)) "transclusion does not render as a broken warning") - (is (contains? (under :annB) :annC) "the pane lists annC under annB") - (is (not (contains? (under :annB) :annA)) "annA is root's child, not annB's")) +(deftest unfile-removes-links-only + (rf-test/run-test-sync + (setup! (seed) [:root]) + (rf/dispatch [::ev/file-into :annC :root]) ; annC now [:annA :root] + (is (= [:annA :root] (:in (get-in (scene*) [:groups :annC])))) + (testing "unfiling a non-primary link removes just that edge" + (rf/dispatch [::ev/unfile :annC :root]) + (is (= [:annA] (:in (get-in (scene*) [:groups :annC]))))) + (testing "the primary home can't be unfiled (nor the last remaining edge)" + (rf/dispatch [::ev/unfile :annC :annA]) + (is (= [:annA] (:in (get-in (scene*) [:groups :annC]))))))) - ;; ISSUE 3 at ROOT — collapse; annC must NOT leak into the root list (it's a - ;; grandchild). ISSUE 2 — revealing annA must then surface annC as its child. - (rf/dispatch-sync [::ev/collapse]) - (is (= [:root] (get-in @rdb/app-db [:view :stack]))) - (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))] - (is (contains? ids :annA) "annA (a root child) shows at root") - (is (not (contains? ids :annC)) "annC does NOT leak into root (grandchild)")) - (rf/dispatch-sync [::ev/toggle-children :annA]) - (let [anns @(rf/subscribe [::subs/all-annotations]) - c (some #(when (= :annC (:id %)) %) anns) - by-parent (subs/annotations-by-parent anns) - revealed (get-in @rdb/app-db [:view :revealed])] - (is c "revealing annA surfaces annC as its child in the toggle") - (is (contains? (:parents c) :annA)) - (is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annA #{}))) - "annA's open panel renders annC") - (is (nil? (subs/visible-child-annotations by-parent revealed :annB #{})) - "annB's closed panel does not render the same transcluded child")) - (rf/dispatch-sync [::ev/toggle-children :annB]) - (let [anns @(rf/subscribe [::subs/all-annotations]) - by-parent (subs/annotations-by-parent anns) - revealed (get-in @rdb/app-db [:view :revealed])] - (is (= [:annC] (mapv :id (subs/visible-child-annotations by-parent revealed :annB #{}))) - "annB renders annC only after its own panel opens")) - (rf/dispatch-sync [::ev/toggle-children :annB]) - (let [anns @(rf/subscribe [::subs/all-annotations]) - by-parent (subs/annotations-by-parent anns) - revealed (get-in @rdb/app-db [:view :revealed])] - (is (nil? (subs/visible-child-annotations by-parent revealed :annB #{})) - "hiding annB's panel removes annC from that panel even though annA still reveals it")) +;; ========================================================================= +;; adding marks from another context (associate-marks) does NOT move placement +;; ========================================================================= - ;; BUG 2 — back in annB, dragging the handle must not delete the mark - ;; (::reroll-proxy must roll against the VIEWED context, not annC's :parent). - (rf/dispatch-sync [::ev/expand :annB]) - (rf/dispatch-sync [::ev/reroll-proxy :annC bid 50 140]) - (let [bars (bars-in :annB :annC)] - (is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)") - (is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140")))))) +(deftest associate-marks-adds-marks-not-membership + (rf-test/run-test-sync + (setup! (seed) [:root]) + ;; drill into annB, author a range on ITS content, tie it to annC + (rf/dispatch [::ev/expand :annB]) + (rf/dispatch [::ev/open-draft]) + (rf/dispatch [::ev/draft-select-range 50 150]) + (let [d (draft-gid)] + (is d "a draft exists after open-draft") + (is (= [:annB] (:in (get-in (scene*) [:groups d]))) "the draft is born filed under annB") + (rf/dispatch [::ev/associate-marks d :annC])) + (testing "annC gains the B-authored mark, but its membership is UNCHANGED (still annA)" + (is (= 2 (count (get-in (scene*) [:groups :annC :marks])))) + (is (= #{:annA} (s/membership (scene*) :annC)) "placement is asserted, not derived from marks")) + ;; associate opened annC in :edit; save it (drops :draft) and leave the form + (rf/dispatch [::ev/save-group :annC (dissoc (get-in (scene*) [:groups :annC]) :draft) nil]) + (rf/dispatch [::ev/finish-edit]) + (testing "so annC does NOT list under annB — even though its footage resolves there" + (is (not (contains? (pane-ids) :annC)) "not filed under annB ⇒ not listed under annB") + (is (= 1 (count (bars-in :annB :annC))) "but its B-mark DOES draw a bar in annB (resolution ≠ membership)") + (is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2)))) + (testing "filing it in explicitly is what makes it list under annB" + (rf/dispatch [::ev/file-into :annC :annB]) + (is (contains? (pane-ids) :annC)) + (is (= #{:annA :annB} (s/membership (scene*) :annC)))))) -(deftest draft-range-events-keep-integer-frames - (testing "basic drag selection through the real event path stores only integer frames" - (setup! clips-scene [:root]) - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 25 175]) - (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) - mark (first (:marks g)) - pid (get-in mark [:start :ref]) - proxy (get-in (scene*) [:groups pid]) - ats (mapcat (fn [m] [(get-in m [:start :at]) (get-in m [:end :at])]) (:marks proxy))] - (is gid "draft exists") - (is (= :proxy (:type proxy))) - (is (every? integer? ats)) - (is (= [[25 175 (:id mark)]] (bars-in :root gid))))) - (testing "fractional drag selection fails instead of being changed into nearby frames" - (setup! clips-scene [:root]) - (rf/dispatch-sync [::ev/open-draft]) - (is (thrown-with-msg? js/Error #"integer frame" - (rf/dispatch-sync [::ev/draft-select-range 25.5 175]))))) +;; ========================================================================= +;; stack push / pop and reveal-children through the real events +;; ========================================================================= -(deftest reroll-proxy-rejects-fractional-frames - (testing "live proxy reroll accepts integer handle positions and rejects fractional ones" - (setup! clips-scene [:root]) - (rf/dispatch-sync [::ev/open-draft]) - (rf/dispatch-sync [::ev/draft-select-range 25 175]) - (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) - mark-id (:id (first (:marks g)))] - (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30 170]) - (is (= [[30 170 mark-id]] (bars-in :root gid))) - (is (thrown-with-msg? js/Error #"integer frame" - (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30.25 170])))))) +(deftest stack-navigation-and-reveal + (rf-test/run-test-sync + (setup! (seed) [:root]) + (testing "expand pushes, pop-to truncates, collapse pops" + (rf/dispatch [::ev/expand :annA]) + (is (= [:root :annA] (:stack (:view @rdb/app-db)))) + (rf/dispatch [::ev/collapse]) + (is (= [:root] (:stack (:view @rdb/app-db)))) + (rf/dispatch [::ev/expand :annA]) + (rf/dispatch [::ev/pop-to :root]) + (is (= [:root] (:stack (:view @rdb/app-db))))) + (testing "at root, revealing annA surfaces its child annC in the SAME pane list" + (is (not (contains? (pane-ids) :annC)) "hidden until annA is revealed") + (is (pos? (:nested (card :annA))) "annA advertises a nested child") + (rf/dispatch [::ev/toggle-children :annA]) + (is (contains? (pane-ids) :annC) "revealed → annC shows as annA's child at root")))) + +;; ========================================================================= +;; JSON wire round-trip of :in (vector, keyworded) via restore-annotations +;; ========================================================================= + +(deftest membership-survives-the-json-wire + (rf-test/run-test-sync + (setup! (seed) [:root]) + (rf/dispatch [::ev/file-into :annC :root]) ; annC :in [:annA :root] + (let [g (get-in (scene*) [:groups :annC]) + ;; exactly what api/put-scene serializes then reads back + wire (js->clj (js/JSON.parse (js/JSON.stringify (clj->js g))) :keywordize-keys true) + back (:annC (s/restore-annotations {:annC wire}))] + (is (vector? (:in back)) ":in stays a vector on the wire (like :tags/:notes)") + (is (= [:annA :root] (:in back)) "gids re-keyworded, order (primary first) preserved") + (is (= :annA (s/home {:groups {:annC back}} :annC)))))) diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index aca12f9..51f717b 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -23,7 +23,7 @@ ;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips. (def inter-x (with-group base :ann-x - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [{:id :m/s0 :start {:ref :clip-b :at 50} :end {:ref :clip-b :at -1}} ; src [150,200) {:id :m/s1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at 50}} ; src [0,50) {:id :m/s2 :start {:ref :clip-b :at 0} :end {:ref :clip-b :at 50}} ; src [100,150) @@ -32,7 +32,7 @@ ;; Y inside X, referencing two of X's subclips (parent = :ann-x) (def x+y (with-group inter-x :ann-y - {:type :annotation :parent :ann-x + {:type :annotation :in [:ann-x] :marks [{:id :m/y0 :start {:ref :m/s0 :at 10} :end {:ref :m/s0 :at 20}} ; s0 10..20 -> src [160,170) {:id :m/y1 :start {:ref :m/s1 :at 0} :end {:ref :m/s1 :at 5}}]})) ; s1 0..5 -> src [0,5) @@ -50,7 +50,7 @@ (deftest rearrange-and-gap-removal (testing "an annotation [C, A] (B skipped) lays C then A end to end, no gap, no B track" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]}) segs (s/resolve scene :ann)] (is (= 200 (s/length segs))) @@ -75,10 +75,10 @@ (testing "subclip[-1] is the SUBCLIP's own end, not the raw clip's last frame" ;; subclip s = A[20,80); referencing s[-1] must give 80, not clip A's 100 (let [scene (-> base - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]}) - (with-group :ann-y {:type :annotation :parent :ann + (with-group :ann-y {:type :annotation :in [:ann] :marks [{:id :m/y :start {:ref :m/s :at 0} :end {:ref :m/s :at -1}}]})) seg (first (s/resolve scene :ann-y))] @@ -88,14 +88,14 @@ (deftest tracks-by-membership (testing "zoom includes exactly the tracks the marks touch" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/c0 :clip-c 0 -1) (refm :m/a0 :clip-a 0 -1)]})] (is (= #{:t2 :t0} (s/tracks (s/resolve scene :ann))))))) (deftest repeat-yields-two-pieces (testing "a clip referenced twice renders at two local positions" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/r0 :clip-a 0 -1) ; A local [0,100) (refm :m/r1 :clip-b 0 -1) ; B local [100,200) (refm :m/r2 :clip-a 0 -1)]}) ; A local [200,300) @@ -162,7 +162,7 @@ (let [p (s/make-proxy base :root 40 210) ; A-tail(40..100)+B+C-head(200..210) scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]})) segs (s/resolve scene :ann)] (is (= 170 (s/length segs))) ; 60 + 100 + 10 @@ -176,7 +176,7 @@ (testing "a within-one-clip selection makes a one-mark proxy that resolves like the clip" (let [p (s/make-proxy base :root 10 60) ; inside A only scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]})) segs (s/resolve scene :ann)] (is (= 1 (count (:marks p)))) @@ -220,7 +220,7 @@ (let [p1 (s/make-proxy base :root 0 200) ; A+B p2 (s/make-proxy base :root 200 300) ; C (abuts B) scene (-> base (with-group :p1 p1) (with-group :p2 p2) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/1 :p1) (s/proxy-ref :m/2 :p2)]})) segs (s/content-segments scene :root) @@ -229,7 +229,7 @@ (is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi] ;; and a single cross-clip proxy on its own is one contiguous bar (let [one (-> base (with-group :p1 p1) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/1 :p1)]}))] (is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root)))))))) @@ -242,7 +242,7 @@ {:id "p2" :start {:ref "clip-c" :at 0} :end {:ref "clip-c" :at 10}}]}} back (:prox (s/restore-annotations json-like)) scene (-> base (with-group :prox back) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]}))] (is (= :proxy (:type back))) (is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back)))) ; refs keyworded @@ -257,7 +257,7 @@ (let [p (s/make-proxy base :root 40 210) ; A-tail=60, B=100, C-head=10 scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]})) segs (s/content-segments scene :ann) ids (mapv :mark segs)] @@ -275,7 +275,7 @@ one mark id — one bar per mark — so the two views stay distinct" (let [p (s/make-proxy base :root 40 210) scene (-> base (with-group :prox p) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :m/px :prox)]}))] (is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann)))))))) @@ -293,7 +293,7 @@ :marks [{:id :sub-c :start {:ref aid :at 0} :end {:ref aid :at -1}}]} scene (-> named (with-group :pA pA) - (with-group :annA {:type :annotation :parent :root :marks [(s/proxy-ref :mA :pA)]}) + (with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]}) (with-group :pin pin))] ;; the ref chain :sub-c → aid → clip-a bottoms out at a clip from anywhere (is (= 100 (s/ref-length scene :sub-c))) ; clip-a's length, no context @@ -302,12 +302,12 @@ (is (= "A-roll" (s/ref-track-name scene :pin))) (is (nil? (s/ref-track-name scene :nope)))))) ; a dangling ref → nil, not a throw -(deftest transclusion-visibility-is-scoped-by-reference-not-clip-overlap - (testing "an annotation shows in a timeline when a mark is BUILT ON that timeline's - content (references its units), not merely when its clips overlap. So a - mark authored in B shows in B though its annotation is parented under A - (transclusion), a mark authored in A shows in A — and a sibling root - annotation that just covers the same clips does NOT leak into B." +(deftest placement-is-membership-listing-is-decoupled-from-where-bars-draw + (testing "an annotation LISTS under the mark-groups in its :in (asserted), while + its bars DRAW wherever its marks resolve (footage ∩ ctx). The two are + independent: a mark authored on annB's content still draws in annB even + when the annotation is only filed under annA — and it does NOT list in + annB until it's filed there." (let [four (assoc-in base [:groups :clip-d] {:type :clip :parent nil :name "D" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t0}]}) @@ -315,35 +315,31 @@ pA (s/make-proxy four :root 0 200) ; annA over clips A,B pB (s/make-proxy four :root 200 400) ; annB over clips C,D scene (-> four (with-group :pA pA) (with-group :pB pB) - (with-group :annA {:type :annotation :parent :root :marks [(s/proxy-ref :mA :pA)]}) - (with-group :annB {:type :annotation :parent :root :marks [(s/proxy-ref :mB :pB)]})) - ;; annC (parented under A) has a mark authored in A AND a mark authored in B - pInA (s/make-proxy scene :annA 10 60) ; a range inside annA (clip A) - pInB (s/make-proxy scene :annB 50 150) ; a range inside annB (C-tail + D-head) - ;; annD is a SIBLING root annotation that merely covers clip C - pDup (s/make-proxy scene :root 200 280) ; clip C, referenced from root directly - scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB) (with-group :pDup pDup) - (with-group :annC {:type :annotation :parent :annA - :marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}) - (with-group :annD {:type :annotation :parent :root - :marks [(s/proxy-ref "d1" :pDup)]}))] - ;; annC has exactly 2 marks (one per authored range); the B one is a single - ;; proxy whose run spans C-tail + D-head — not expanded into per-clip marks - (is (= 2 (count (:marks (get-in scene [:groups :annC]))))) - (is (= 2 (count (:marks pInB)))) ; run held inside the ONE proxy - ;; annC's marks are homed in A and B → it is a child of BOTH, and NOT of root - ;; (it's a grandchild there — one-hop reference, not transitive to clips) - (is (= #{:annA :annB} (s/mark-homes scene :annC))) + (with-group :annA {:type :annotation :in [:root] :marks [(s/proxy-ref :mA :pA)]}) + (with-group :annB {:type :annotation :in [:root] :marks [(s/proxy-ref :mB :pB)]})) + ;; annC is FILED under annA only, but holds a mark authored on annA's + ;; content AND a mark authored on annB's content (C-tail + D-head) + pInA (s/make-proxy scene :annA 10 60) + pInB (s/make-proxy scene :annB 50 150) + scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB) + (with-group :annC {:type :annotation :in [:annA] + :marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]}))] + ;; MEMBERSHIP (listing) is exactly :in — asserted, single here + (is (= #{:annA} (s/membership scene :annC))) + (is (= :annA (s/home scene :annC))) ; primary = first :in (is (s/child-of? scene :annA :annC)) - (is (s/child-of? scene :annB :annC)) - (is (not (s/child-of? scene :root :annC))) ; grandchild does NOT leak to root - ;; annD only covers clip C from root — homed at root, NOT a child of annB - (is (= #{:root} (s/mark-homes scene :annD))) - (is (not (s/child-of? scene :annB :annD))) ; the over-show bug - (is (s/child-of? scene :root :annD)) - ;; lane bars follow: annC's B-mark renders in B, its A-mark in A, none of annD in B + (is (not (s/child-of? scene :annB :annC))) ; NOT filed under B → not listed there + (is (not (s/child-of? scene :root :annC))) + ;; RESOLUTION (bars) is independent of membership: the cb mark still draws in + ;; annB's lane because its FOOTAGE lands there, even though annC isn't filed in B (is (= [[50 150 "cb"]] (s/lane-bars scene :annC (s/content-segments scene :annB)))) - (is (seq (s/lane-bars scene :annC (s/content-segments scene :annA))))))) + (is (seq (s/lane-bars scene :annC (s/content-segments scene :annA)))) + ;; filing annC into annB (an assertion) makes it LIST there too; bars unchanged + (let [scene2 (assoc-in scene [:groups :annC :in] [:annA :annB])] + (is (s/child-of? scene2 :annB :annC)) + (is (= #{:annA :annB} (s/membership scene2 :annC))) + (is (= :annA (s/home scene2 :annC))) ; primary still first + (is (= [[50 150 "cb"]] (s/lane-bars scene2 :annC (s/content-segments scene2 :annB)))))))) (deftest jump-targets-label-from-the-clip-not-the-proxy (testing "a discontinuous annotation's jump popover labels each target from the @@ -352,7 +348,7 @@ (let [pa (s/make-proxy base :root 0 50) ; within clip A pc (s/make-proxy base :root 250 300) ; within clip C (non-adjacent → 2 runs) scene (-> base (with-group :pa pa) (with-group :pc pc) - (with-group :ann {:type :annotation :parent :root + (with-group :ann {:type :annotation :in [:root] :marks [(s/proxy-ref :ma :pa) (s/proxy-ref :mc :pc)]})) segs (s/content-segments scene :root) jumps (s/jump-targets scene :root :ann)] @@ -481,7 +477,7 @@ (deftest frames-are-mark-time-under-parent-trim (testing "frames are 0-based within the TRIMMED segment, not raw clip time" (let [scene (with-group base :p - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [{:id :m/s :start {:ref :clip-a :at 20} :end {:ref :clip-a :at 80}}]}) segs (s/content-segments scene :p)] (is (= 60 (s/seg-length segs :m/s))) ; trimmed length, not 100 @@ -508,7 +504,8 @@ :end {:ref "clip-a" :at -1}}]}} g (:ann-1 (s/restore-annotations json-like))] (is (= :annotation (:type g))) - (is (= :root (:parent g))) + (is (= [:root] (:in g))) ; legacy :parent migrated to an :in edge + (is (nil? (:parent g))) ; and the old field is dropped (is (= :clip-a (get-in g [:marks 0 :start :ref]))) (let [scene (assoc-in base [:groups :ann-1] g)] (is (= [0 100] (:src (first (s/resolve scene :ann-1))))))))) @@ -519,9 +516,9 @@ (deftest annotations-survive-json-roundtrip (testing "restore-annotations is the exact inverse of the JSON wire trip — guards against any keyword-valued field (id/ref/type/parent/track) being missed" - (let [anns {:ann-p {:v s/schema-version :type :annotation :parent :root :name "p" :color "#abc" :content "hi" + (let [anns {:ann-p {:v s/schema-version :type :annotation :in [:root] :name "p" :color "#abc" :content "hi" :marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]} - :ann-c {:v s/schema-version :type :annotation :parent :ann-p :name "c" + :ann-c {:v s/schema-version :type :annotation :in [:ann-p] :name "c" :marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}] (is (= anns (s/restore-annotations (json-roundtrip anns))))))) @@ -578,7 +575,7 @@ (deftest repeats-are-unambiguous (testing "two instances of A share a source frame but distinct locals (local is master)" (let [scene (with-group base :ann - {:type :annotation :parent :root + {:type :annotation :in [:root] :marks [(refm :m/r0 :clip-a 0 -1) (refm :m/r1 :clip-b 0 -1) (refm :m/r2 :clip-a 0 -1)]}) segs (s/resolve scene :ann)] (is (= 5 (s/local->source segs 5))) ; first A @@ -610,9 +607,9 @@ (deftest path-to-builds-stack-and-drops-orphans (let [scene {:groups {:root {:type :timeline :parent nil} - :a {:type :annotation :parent :root} - :b {:type :annotation :parent :a} - :orphan {:type :annotation :parent :gone}}}] + :a {:type :annotation :in [:root]} + :b {:type :annotation :in [:a]} + :orphan {:type :annotation :in [:gone]}}}] (testing "path is root → … → target" (is (= [:root] (s/path-to scene :root))) (is (= [:root :a] (s/path-to scene :a)))