noe/tl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat: :in membership edges replace transclusion/mark-home placement

Browse source 
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 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-07-07 13:07:49 -04:00
parent 4b29962677
commit 65a80857be
8 changed files with 447 additions and 430 deletions
Download patch file Download diff file Expand all files Collapse all files

16
tl/resources/public/css/app.css
View file

@ -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;

1
tl/shadow-cljs.edn
View file

@ -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

188
tl/src/tl/events.cljs
View file

@ -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])]

121
tl/src/tl/scene.cljs
View file

@ -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)))

36
tl/src/tl/subs.cljs
View file

@ -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

65
tl/src/tl/views.cljs
View file

@ -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

339
tl/test/tl/flow_test.cljs
View file

@ -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))))))

111
tl/test/tl/scene_test.cljs
View file

@ -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)))