Refuse a symbol placed inside itself, and label instances by what they place

A paste put an instance of "bg" inside "bg" itself. It saved, loaded, and then
threw "symbol cycle in audio" out of nest/audio-tracks, because a container that
contains itself has no finite expansion.

place-symbol and ui/drag already refused that, each by asking
clip/contains-symbol?. Paste asks clip/problems instead, and problems did not
encode the invariant at all -- it checked missing symbols, pose tracks and audio
links, but never the placement graph. So the rule goes where every command is
already checked: paste, cut, duplicate, correction and the span ops all gate on
problems, so one rule covers them all.

Why it looked like a reasonable thing to do is the other half. place-symbol
copied the symbol's name onto the instance it made, and that copy went stale on
the next rename: the symbol read "bg" in its tab while an instance of it still
read "symbol-18", which is its id from before it was named. One object under two
names, with nothing on screen to connect them.

So instances are no longer given a name at creation, and clip/node-label reads
the symbol's name through on every render. :name on an instance now means only
what a person typed, which is what tells two instances of one symbol apart --
"8625 left" and "8625 right" of one "face" -- so an authored name still wins and
read-through is the fallback. The label logic was duplicated across four call
sites with three different fallback orders; location.cljs already read through
and the others did not. They now share one function.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>

frontend/src/arthur/domain/clip.cljs

@@ -64,6 +64,31 @@
   [clip sid]
   (or (:name (symbol clip sid)) (name sid)))
 
+(defn node-label
+  "What to call node `n` on screen.
+
+  A NAME A PERSON TYPED WINS, and for an instance that is the ONLY thing `:name`
+  now means: `place-symbol` deliberately does not copy the symbol's name onto the
+  node it makes. Two instances of one symbol are told apart by what somebody
+  called them — `8625 left` and `8625 right` of one `face` — and reading through
+  in front of that would collapse them to the same word.
+
+  OTHERWISE AN INSTANCE IS LABELLED BY WHAT IT PLACES, read through on every
+  render. A name copied at creation goes stale the moment the symbol is renamed,
+  and then the document shows one thing under two names: the symbol reads `bg` in
+  its tab while an instance of it still reads `symbol-18`, which is how a person
+  comes to paste a symbol into itself without being able to see that is what they
+  are doing. `problems` refuses that cycle; this is why it stops looking like a
+  reasonable thing to try.
+
+  An id is a uuid for a placement and a keyword for an authored node, and neither
+  reads as a name, so the last resort is a legible stand-in rather than `(str
+  id)` — `:face-1` keeps its colon and a uuid pushes a column open."
+  [clip id n]
+  (or (:name n)
+      (some->> (node/source n) (symbol-name clip))
+      (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))
+
 (defn frames
   "A symbol's length. Read off the symbol, never copied beside it."
   [clip sid]
@@ -495,7 +520,6 @@
         (update-symbol
          clip host assoc-in [:nodes uuid]
          {:id uuid
-          :name (symbol-name clip sid)
           :kind :instance
           :parent nil
           ;; Lexicographic draw order, as `domain/paint` does it: an instance made
@@ -615,6 +639,23 @@
           missing (remove (:symbols clip) (node/sources n))]
       (str "symbol " (pr-str sid) " instance " (pr-str id)
            " names missing symbol " (pr-str missing)))
+    ;; THE INVARIANT `place-symbol` AND `ui/drag` ALREADY ENFORCE, stated here so
+    ;; that every command is checked against it rather than the two that remember
+    ;; to ask. A symbol placed inside itself, or inside anything it places, has no
+    ;; finite expansion: `build` above and `nest/audio-tracks` both walk instances
+    ;; and both throw on the way round. Paste reached this function without it and
+    ;; wrote a document that saved, loaded, and only then threw — which is the one
+    ;; outcome `problems` exists to make impossible.
+    (for [[sid sym] (:symbols clip)
+          [id n] (:nodes sym)
+          :when (= :instance (:kind n))
+          src (node/sources n)
+          ;; A source that does not exist is the rule above's to report, not this
+          ;; one's, so it does not get named twice.
+          :when (and (contains? (:symbols clip) src)
+                     (contains-symbol? clip src sid))]
+      (str "symbol " (pr-str sid) " instance " (pr-str id) " places "
+           (pr-str src) (if (= src sid) ", which is itself" ", which contains it")))
     ;; Pose tracks belong to this cel's single source symbol.
     (for [[sid sym] (:symbols clip)
           [id n] (:nodes sym)

frontend/src/arthur/events/export.cljs

@@ -10,7 +10,8 @@
   WHAT GOES IN THE DB IS THE REQUEST AND THE PROGRESS, never the frames. A
   megabyte of PNG in app-db would be compared by every mounted subscription on
   every tick."
-  (:require [arthur.domain.palette :as pal]
+  (:require [arthur.domain.clip :as clip]
+            [arthur.domain.palette :as pal]
             [arthur.export :as export]
             [arthur.export.frames :as frames]
             [arthur.footage.store :as store]
@@ -77,17 +78,17 @@
   the other instances removed, which is why seven instances of one symbol are
   seven different exports rather than seven copies of one.
 
-  Instances are ordered and labelled by `:name`, never by id: a uuid sorts at
+  Instances are ordered and labelled by `clip/node-label`, never by id: a uuid
-  random and means nothing to read."
+  sorts at random and means nothing to read."
   [clip open]
-  (let [instances (->> (get-in clip [:symbols open :nodes])
+  (let [label #(clip/node-label clip %1 %2)
+        instances (->> (get-in clip [:symbols open :nodes])
                        (filter (comp #{:instance} :kind val))
-                       (sort-by (fn [[id n]] [(or (:name n) "") (str id)])))]
+                       (sort-by (fn [[id n]] [(label id n) (str id)])))]
     (into (mapv (fn [sid] {:symbol sid :label (name sid)})
                 (sort-by str (keys (:symbols clip))))
           (mapv (fn [[id n]]
-                  {:symbol open :isolate id
+                  {:symbol open :isolate id :label (label id n)})
-                   :label (or (:name n) (str id))})
                 instances))))
 
 (defn target

frontend/src/arthur/ui/location.cljs

@@ -37,11 +37,7 @@
   else is named as the timeline names it: `:name` when it has one, and a legible
   stand-in when it has not."
   [clip id n]
-  (let [of (node/source n)]
+  (clip/node-label clip id n))
-    (or (when of (:name (clip/symbol clip of)))
-        (:name n)
-        (when of (name of))
-        (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8)))))
 
 (defn trail
   "The crumbs from symbol `sid` down to the end of row path `path`, the symbol

frontend/src/arthur/ui/stage.cljs

@@ -322,9 +322,11 @@
   []
   (let [{:keys [world bounds id node]}
         @(rf/subscribe [::sub/creation-placement])
+        ;; `::render/clip` rather than `loaded`: this runs at render time, which
+        ;; is the one thing that docstring says the non-reactive read is not for.
+        document @(rf/subscribe [::render/clip])
         n node
-        label (or (:name n) (some-> (node/source n) name)
+        label (when id (clip/node-label document id n))]
-                  (when id (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))]
     (when (and world bounds)
       (let [[x0 y0 x1 y1] bounds
             corners (pairs (through world [x0 y0 x1 y0 x1 y1 x0 y1]))

frontend/src/arthur/ui/timeline.cljs

@@ -78,13 +78,10 @@
 (defn- node-label
   "What to call a node in the label column.
 
-  A placement's id is a uuid and an authored node's is a keyword, and neither
+  See `clip/node-label`, which this defers to: an instance is labelled by the
-  reads as a name: `(str id)` gives `:face-1` with the colon still on it, or
+  symbol it places, read through so a rename reaches every row that shows it."
-  thirty-six characters of hex that push the column open. `:name` when there is
+  [clip id n]
-  one, and a legible stand-in when there is not."
+  (clip/node-label clip id n))
-  [id n]
-  (or (:name n)
-      (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))
 
 (defn- channel-rows [n path depth ->open span]
   (let [keyed (filter (comp seq :keys val)
@@ -162,7 +159,7 @@
                   cspan    (mapv self (node/placed-span child))
                   row {:path   cpath
                        :depth  depth
-                       :label  (node-label (:id child) child)
+                       :label  (node-label clip (:id child) child)
                        :kind   :node
                        :node-kind (:kind child)
                        :of     (node/source child)
@@ -215,7 +212,7 @@
                                                       {:id (:id child)
                                                        :label (or (get-in clip [:symbols (node/source child) :name])
                                                                   (some-> (node/source child) name)
-                                                                  (node-label (:id child) child))
+                                                                  (node-label clip (:id child) child))
                                                        :source (node/source child)
                                                        :span (mapv ->open (node/placed-span child))
                                                        :keys (into []
@@ -272,7 +269,7 @@
                                                 [0 (:frames sym)]))
                              row {:path   rpath
                                   :depth  depth
-                                  :label  (node-label id n)
+                                  :label  (node-label clip id n)
                                   :kind   :node
                                   :node-kind (:kind n)
                                   :lane? lane?
@@ -380,7 +377,7 @@
               select [:node (:owner n) (:id n) path]
               open? (contains? expanded path)
               via (when (< 1 (count path)) (str (first path)))
-              row {:path path :depth 0 :label (node-label (:id n) n)
+              row {:path path :depth 0 :label (node-label clip (:id n) n)
                    :kind :node :node-kind :audio :via via
                    :slides (if via (subvec path 0 1) path)
                    :select select :expandable? true :expanded? open? :span span
@@ -388,7 +385,7 @@
           (cons (cond-> row
                   (< 1 (count tracks))
                   (assoc :cels (mapv (fn [i track]
-                                      {:id i :label (node-label (:id track) track)
+                                      {:id i :label (node-label clip (:id track) track)
                                        :span (own-span (node/placed-span track))
                                        :select select})
                                     (range) tracks)))

frontend/test/arthur/domain/clipboard_test.cljs

@@ -39,6 +39,27 @@
         "an ordinary symbol may contain cropped content beyond its window")
     (is (empty? (clip/problems made)))))
 
+(deftest pasting-a-symbol-into-itself-is-refused
+  ;; What happened to a real document: an instance of "bg" was copied from the
+  ;; symbol holding it, and pasted while "bg" itself was the open symbol. Nothing
+  ;; on the paste path looked at the placement graph, so it saved, loaded, and
+  ;; then threw "symbol cycle in audio" out of nest/audio-tracks.
+  (let [doc (-> (clip/blank)
+                (assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
+                (assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
+                (clip/place-symbol nil :outer :inner 5 (random-uuid) nil))
+        id (first (keys (get-in doc [:symbols :outer :nodes])))
+        payload (:clipboard (clipboard/snapshot doc [(address :outer id [id])]))]
+    (testing "into the symbol it places"
+      (let [r (clipboard/paste doc payload :inner 0 {:fresh-id (ids)})]
+        (is (= "symbol :inner instance :copy-1 places :inner, which is itself"
+               (:refused r)))
+        (is (nil? (:clip r)) "and the document is not handed back changed")))
+    (testing "while pasting it somewhere harmless still works"
+      (let [r (clipboard/paste doc payload :outer 0 {:fresh-id (ids)})]
+        (is (nil? (:refused r)))
+        (is (empty? (clip/problems (:clip r))))))))
+
 (deftest lane-paste-claims-time-as-one-command
   (let [doc (fixture/document)
         payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))

frontend/test/arthur/domain/instance_test.cljs

@@ -235,6 +235,51 @@
       (is (= (get-in c [:symbols :outer :nodes])
              (get-in (leaf/clip "c" (leaf/leaves "c" c)) [:symbols :outer :nodes]))))))
 
+(deftest an-instance-is-labelled-by-what-it-places
+  (let [c (-> (nested)
+              (assoc-in [:symbols :inner :name] "mouth"))
+        [id n] (first (get-in c [:symbols :outer :nodes]))]
+    (testing "placing does not copy the symbol's name onto the node"
+      (is (nil? (:name n))
+          "a cached name is what goes stale; there is nothing to go stale"))
+    (testing "so the label follows the symbol, including a later rename"
+      (is (= "mouth" (clip/node-label c id n)))
+      (is (= "jaw" (clip/node-label (assoc-in c [:symbols :inner :name] "jaw") id n))
+          "renaming the symbol renames every row that shows an instance of it"))
+    (testing "an unnamed symbol falls back to its id, not to the node's uuid"
+      (is (= "inner" (clip/node-label (update-in c [:symbols :inner] dissoc :name)
+                                      id n))))
+    (testing "but a name somebody typed on the instance still wins"
+      ;; Two instances of one symbol are told apart only by this.
+      (is (= "left eye" (clip/node-label c id (assoc n :name "left eye")))))
+    (testing "and a node that places nothing is labelled by its own name or id"
+      (is (= "lid" (clip/node-label c :lid {:id :lid :kind :rect :name "lid"})))
+      (is (= "lid" (clip/node-label c :lid {:id :lid :kind :rect}))))))
+
+(deftest a-cycle-is-a-problem-and-not-only-a-refusal
+  ;; `place-symbol` and `ui/drag` refuse to MAKE one; this is the document being
+  ;; asked whether it already has one, which is the question every other command
+  ;; — paste above all — gets to ask by calling `clip/problems`.
+  (let [c (nested)
+        instance (fn [c host src]
+                   (assoc-in c [:symbols host :nodes :loop]
+                             {:id :loop :kind :instance :z "z" :parent nil
+                              :span [0 10] :time {:mode :map :at 0 :rate 1}
+                              :source {:symbol src}}))]
+    (testing "a symbol placed inside itself"
+      (is (= ["symbol :inner instance :loop places :inner, which is itself"]
+             (clip/problems (instance c :inner :inner)))))
+    (testing "a symbol placed inside something it already places"
+      ;; Both edges of :outer -> :inner -> :outer close the loop, so both are
+      ;; named: either one is a fair thing to undo.
+      (let [ps (clip/problems (instance c :inner :outer))]
+        (is (= 2 (count ps)))
+        (is (some #{"symbol :inner instance :loop places :outer, which contains it"} ps))
+        (is (some #(re-find #"^symbol :outer instance .* places :inner, which contains it$" %)
+                  ps))))
+    (testing "and an instance that closes no loop is still fine"
+      (is (empty? (clip/problems (instance c :loose :inner)))))))
+
 (deftest a-new-symbol-is-empty-and-placed-where-it-was-asked-for
   (let [c    (nested)
         u    #uuid "00000000-0000-4000-8000-000000000001"