giles
5ed984e7e3
Nav refactoring: - Split nav-data.sx (32 forms) into 6 files: nav-geography, nav-language, nav-applications, nav-etc, nav-tools, nav-tree - Add Tools top-level nav category with SX Tools and Services pages - New services-tools.sx page documenting the rose-ash-services MCP server JS build fixes (fixes 5 Playwright failures): - Wire web/web-signals.sx into JS build (stores, events, resources) - Add cek-try primitive to JS platform (island hydration error handling) - Merge PRIMITIVES into getRenderEnv (island env was missing primitives) - Rename web/signals.sx → web/web-signals.sx to avoid spec/ collision New MCP tools: - sx_trace: step-through CEK evaluation showing lookups, calls, returns - sx_deps: dependency analysis — free symbols + cross-file resolution - sx_build_manifest: show build contents for JS and OCaml targets - sx_harness_eval extended: multi-file loading + setup expressions Deep path bug fix: - Native OCaml list-replace and navigate bypass CEK callback chain - Fixes sx_replace_node and sx_read_subtree corruption on paths 6+ deep Tests: 1478/1478 JS full suite, 91/91 Playwright Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
752 lines
30 KiB
Plaintext
752 lines
30 KiB
Plaintext
;; ==========================================================================
|
|
;; test-tree-tools.sx — Tests for structural comprehension tools
|
|
;; ==========================================================================
|
|
|
|
(defsuite "tree-tools"
|
|
|
|
;; ========================================================================
|
|
;; path-str
|
|
;; ========================================================================
|
|
|
|
(deftest "path-str formats index path"
|
|
(assert-equal "[0,2,1]" (path-str (list 0 2 1))))
|
|
|
|
(deftest "path-str single element"
|
|
(assert-equal "[0]" (path-str (list 0))))
|
|
|
|
(deftest "path-str empty"
|
|
(assert-equal "[]" (path-str (list))))
|
|
|
|
(deftest "path-str deep path"
|
|
(assert-equal "[0,1,2,3,4,5]" (path-str (list 0 1 2 3 4 5))))
|
|
|
|
;; ========================================================================
|
|
;; navigate
|
|
;; ========================================================================
|
|
|
|
(deftest "navigate to root element"
|
|
(let ((tree (sx-parse "(defcomp ~card () (div))")))
|
|
(let ((node (navigate tree (list 0))))
|
|
(assert (list? node))
|
|
(assert-equal "defcomp" (symbol-name (first node))))))
|
|
|
|
(deftest "navigate to atom child"
|
|
(let ((tree (sx-parse "(add 1 2)")))
|
|
(assert-equal 1 (navigate tree (list 0 1)))
|
|
(assert-equal 2 (navigate tree (list 0 2)))))
|
|
|
|
(deftest "navigate to nested child"
|
|
(let ((tree (sx-parse "(a (b (c d)))")))
|
|
(let ((node (navigate tree (list 0 1 1 1))))
|
|
(assert-equal "d" (symbol-name node)))))
|
|
|
|
(deftest "navigate invalid path returns nil"
|
|
(let ((tree (sx-parse "(a b c)")))
|
|
(assert (nil? (navigate tree (list 0 5))))))
|
|
|
|
(deftest "navigate empty path returns root list"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((node (navigate tree (list))))
|
|
(assert (list? node))
|
|
(assert-equal 1 (len node)))))
|
|
|
|
(deftest "navigate deep path"
|
|
(let ((tree (sx-parse "(let ((x 1)) (if x (+ x 1) 0))")))
|
|
(let ((node (navigate tree (list 0 2 2 1))))
|
|
(assert-equal "x" (symbol-name node)))))
|
|
|
|
(deftest "navigate to string"
|
|
(let ((tree (sx-parse "(div \"hello\")")))
|
|
(assert-equal "hello" (navigate tree (list 0 1)))))
|
|
|
|
(deftest "navigate to keyword"
|
|
(let ((tree (sx-parse "(div :class \"card\")")))
|
|
(assert-equal "keyword" (type-of (navigate tree (list 0 1))))))
|
|
|
|
(deftest "navigate past atom returns nil"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(assert (nil? (navigate tree (list 0 1 0))))))
|
|
|
|
(deftest "navigate multiple top-level forms"
|
|
(let ((tree (sx-parse "(define x 1) (define y 2)")))
|
|
(assert-equal "x" (symbol-name (navigate tree (list 0 1))))
|
|
(assert-equal "y" (symbol-name (navigate tree (list 1 1))))))
|
|
|
|
;; ========================================================================
|
|
;; node-display
|
|
;; ========================================================================
|
|
|
|
(deftest "node-display symbol"
|
|
(let ((tree (sx-parse "foo")))
|
|
(assert-equal "foo" (node-display (first tree)))))
|
|
|
|
(deftest "node-display number"
|
|
(assert-equal "42" (node-display 42)))
|
|
|
|
(deftest "node-display string short"
|
|
(assert-equal "\"hello\"" (node-display "hello")))
|
|
|
|
(deftest "node-display string truncated"
|
|
(let ((long "this is a very long string that exceeds forty characters limit"))
|
|
(let ((result (node-display long)))
|
|
(assert (contains? result "..."))
|
|
(assert (< (len result) 50)))))
|
|
|
|
(deftest "node-display nil"
|
|
(assert-equal "nil" (node-display nil)))
|
|
|
|
(deftest "node-display boolean"
|
|
(assert-equal "true" (node-display true))
|
|
(assert-equal "false" (node-display false)))
|
|
|
|
(deftest "node-display keyword"
|
|
(let ((tree (sx-parse ":class")))
|
|
(assert-equal ":class" (node-display (first tree)))))
|
|
|
|
(deftest "node-display list preview"
|
|
(let ((tree (sx-parse "(div (span \"hi\") (p \"bye\"))")))
|
|
(let ((result (node-display (first tree))))
|
|
(assert (contains? result "div"))
|
|
(assert (contains? result "...")))))
|
|
|
|
(deftest "node-display empty list"
|
|
(assert-equal "()" (node-display (list))))
|
|
|
|
;; ========================================================================
|
|
;; annotate-tree
|
|
;; ========================================================================
|
|
|
|
(deftest "annotate simple list — compact form"
|
|
(let ((tree (sx-parse "(add 1 2)")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "[0]"))
|
|
(assert (contains? result "(add 1 2)")))))
|
|
|
|
(deftest "annotate nested list — multi-line"
|
|
(let ((tree (sx-parse "(div (span \"hello\"))")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "[0] (div"))
|
|
(assert (contains? result "[0,1] (span \"hello\")")))))
|
|
|
|
(deftest "annotate multiple top-level forms"
|
|
(let ((tree (sx-parse "(define x 1) (define y 2)")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "[0]"))
|
|
(assert (contains? result "[1]"))
|
|
(assert (contains? result "x"))
|
|
(assert (contains? result "y")))))
|
|
|
|
(deftest "annotate deeply nested"
|
|
(let ((tree (sx-parse "(a (b (c (d 1))))")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "[0] (a"))
|
|
(assert (contains? result "[0,1] (b"))
|
|
(assert (contains? result "[0,1,1] (c"))
|
|
(assert (contains? result "[0,1,1,1] (d 1)")))))
|
|
|
|
(deftest "annotate preserves string content"
|
|
(let ((tree (sx-parse "(div :class \"my-class\" \"content\")")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "\"my-class\""))
|
|
(assert (contains? result "\"content\"")))))
|
|
|
|
(deftest "annotate single atom"
|
|
(let ((tree (sx-parse "42")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "[0] 42")))))
|
|
|
|
(deftest "annotate empty list"
|
|
(let ((tree (sx-parse "()")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "()")))))
|
|
|
|
(deftest "annotate defcomp structure"
|
|
(let ((tree (sx-parse "(defcomp ~card (&key title) (div (h2 title)))")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "[0] (defcomp"))
|
|
(assert (contains? result "~card"))
|
|
(assert (contains? result "[0,3] (div")))))
|
|
|
|
;; ========================================================================
|
|
;; summarise
|
|
;; ========================================================================
|
|
|
|
(deftest "summarise at depth 0 shows only heads"
|
|
(let ((tree (sx-parse "(defcomp ~card () (div (span \"hi\")))")))
|
|
(let ((result (summarise tree 0)))
|
|
(assert (contains? result "defcomp"))
|
|
(assert (not (contains? result "span"))))))
|
|
|
|
(deftest "summarise at depth 1 shows one level"
|
|
(let ((tree (sx-parse "(defcomp ~card () (div (span \"hi\")))")))
|
|
(let ((result (summarise tree 1)))
|
|
(assert (contains? result "defcomp"))
|
|
(assert (contains? result "~card"))
|
|
(assert (contains? result "div")))))
|
|
|
|
(deftest "summarise at depth 2 shows two levels"
|
|
(let ((tree (sx-parse "(a (b (c (d 1))))")))
|
|
(let ((result (summarise tree 2)))
|
|
(assert (contains? result "a"))
|
|
(assert (contains? result "b"))
|
|
(assert (contains? result "c"))
|
|
;; d should be folded
|
|
(assert (not (contains? result "[0,1,1,1]"))))))
|
|
|
|
(deftest "summarise shows child count at fold"
|
|
(let ((tree (sx-parse "(div (span \"a\") (span \"b\") (span \"c\"))")))
|
|
(let ((result (summarise tree 0)))
|
|
(assert (contains? result "children")))))
|
|
|
|
(deftest "summarise multiple top-level forms"
|
|
(let ((tree (sx-parse "(define x 1) (define y 2) (define z 3)")))
|
|
(let ((result (summarise tree 0)))
|
|
(assert (contains? result "[0]"))
|
|
(assert (contains? result "[1]"))
|
|
(assert (contains? result "[2]")))))
|
|
|
|
;; ========================================================================
|
|
;; read-subtree
|
|
;; ========================================================================
|
|
|
|
(deftest "read-subtree expands target"
|
|
(let ((tree (sx-parse "(a (b (c 1) (d 2)) (e 3))")))
|
|
(let ((result (read-subtree tree (list 0 1))))
|
|
(assert (contains? result "b"))
|
|
(assert (contains? result "c"))
|
|
(assert (contains? result "d"))
|
|
(assert (not (contains? result " e "))))))
|
|
|
|
(deftest "read-subtree invalid path gives error"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (read-subtree tree (list 5))))
|
|
(assert (contains? result "Error")))))
|
|
|
|
(deftest "read-subtree on atom"
|
|
(let ((tree (sx-parse "(a \"hello\" 42)")))
|
|
(let ((result (read-subtree tree (list 0 1))))
|
|
(assert (contains? result "\"hello\"")))))
|
|
|
|
(deftest "read-subtree on deeply nested"
|
|
(let ((tree (sx-parse "(a (b (c (d (e 1)))))")))
|
|
(let ((result (read-subtree tree (list 0 1 1 1))))
|
|
(assert (contains? result "e"))
|
|
(assert (contains? result "1")))))
|
|
|
|
;; ========================================================================
|
|
;; get-context
|
|
;; ========================================================================
|
|
|
|
(deftest "get-context shows enclosing chain"
|
|
(let ((tree (sx-parse "(let ((x 1)) (if x (+ x 1) 0))")))
|
|
(let ((result (get-context tree (list 0 2 2))))
|
|
(assert (contains? result "[0]"))
|
|
(assert (contains? result "let"))
|
|
(assert (contains? result "[0,2]"))
|
|
(assert (contains? result "[0,2,2]")))))
|
|
|
|
(deftest "get-context marks deepest with arrow"
|
|
(let ((tree (sx-parse "(a (b (c d)))")))
|
|
(let ((result (get-context tree (list 0 1 1))))
|
|
(assert (contains? result "→")))))
|
|
|
|
(deftest "get-context single level"
|
|
(let ((tree (sx-parse "(a b c)")))
|
|
(let ((result (get-context tree (list 0))))
|
|
(assert (contains? result "[0]"))
|
|
(assert (contains? result "a")))))
|
|
|
|
(deftest "get-context defcomp chain"
|
|
(let ((tree (sx-parse "(defcomp ~card () (div :class \"c\" (h2 \"title\")))")))
|
|
(let ((result (get-context tree (list 0 3 3))))
|
|
(assert (contains? result "defcomp"))
|
|
(assert (contains? result "div"))
|
|
(assert (contains? result "h2")))))
|
|
|
|
;; ========================================================================
|
|
;; find-all
|
|
;; ========================================================================
|
|
|
|
(deftest "find-all locates symbols by name"
|
|
(let ((tree (sx-parse "(define foo 1) (define bar (+ foo 2))")))
|
|
(let ((results (find-all tree "foo")))
|
|
(assert (>= (len results) 2)))))
|
|
|
|
(deftest "find-all locates list heads"
|
|
(let ((tree (sx-parse "(div (span \"a\") (span \"b\") (p \"c\"))")))
|
|
(let ((results (find-all tree "span")))
|
|
(assert (>= (len results) 2)))))
|
|
|
|
(deftest "find-all returns empty for no match"
|
|
(let ((tree (sx-parse "(a b c)")))
|
|
(assert (empty? (find-all tree "zzz")))))
|
|
|
|
(deftest "find-all finds nested deeply"
|
|
(let ((tree (sx-parse "(a (b (c (target 1))))")))
|
|
(let ((results (find-all tree "target")))
|
|
(assert (>= (len results) 1)))))
|
|
|
|
(deftest "find-all finds string content"
|
|
(let ((tree (sx-parse "(div \"hello world\" (p \"goodbye\"))")))
|
|
(let ((results (find-all tree "hello")))
|
|
(assert (>= (len results) 1)))))
|
|
|
|
(deftest "find-all finds component names"
|
|
(let ((tree (sx-parse "(defcomp ~my-card () (div)) (defcomp ~my-button () (button))")))
|
|
(let ((results (find-all tree "~my-card")))
|
|
(assert (>= (len results) 1)))))
|
|
|
|
(deftest "find-all returns paths"
|
|
(let ((tree (sx-parse "(a (b target) (c target))")))
|
|
(let ((results (find-all tree "target")))
|
|
;; Each result is (path summary)
|
|
(assert (list? (first (first results)))))))
|
|
|
|
;; ========================================================================
|
|
;; get-siblings
|
|
;; ========================================================================
|
|
|
|
(deftest "get-siblings shows all children of parent"
|
|
(let ((tree (sx-parse "(div (span \"a\") (p \"b\") (em \"c\"))")))
|
|
(let ((result (get-siblings tree (list 0 2))))
|
|
(assert (contains? result "div"))
|
|
(assert (contains? result "span"))
|
|
(assert (contains? result "p"))
|
|
(assert (contains? result "em"))
|
|
(assert (contains? result "→")))))
|
|
|
|
(deftest "get-siblings marks correct target"
|
|
(let ((tree (sx-parse "(a b c d e)")))
|
|
(let ((result (get-siblings tree (list 0 3))))
|
|
;; d is at index 3, should be marked
|
|
(assert (contains? result "→ [0,3]")))))
|
|
|
|
(deftest "get-siblings error on root"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (get-siblings tree (list))))
|
|
(assert (contains? result "Error")))))
|
|
|
|
(deftest "get-siblings first child"
|
|
(let ((tree (sx-parse "(div (span) (p) (em))")))
|
|
(let ((result (get-siblings tree (list 0 1))))
|
|
(assert (contains? result "→ [0,1]")))))
|
|
|
|
;; ========================================================================
|
|
;; validate
|
|
;; ========================================================================
|
|
|
|
(deftest "validate passes clean tree"
|
|
(let ((tree (sx-parse "(defcomp ~card () (div))")))
|
|
(assert-equal "OK" (validate tree))))
|
|
|
|
(deftest "validate catches malformed letrec binding"
|
|
(let ((tree (sx-parse "(letrec (42 (fn () nil)) nil)")))
|
|
(let ((result (validate tree)))
|
|
(assert (contains? result "WARNING"))
|
|
(assert (contains? result "letrec")))))
|
|
|
|
(deftest "validate catches defcomp with no body"
|
|
(let ((tree (sx-parse "(defcomp ~card)")))
|
|
(let ((result (validate tree)))
|
|
(assert (contains? result "ERROR"))
|
|
(assert (contains? result "defcomp")))))
|
|
|
|
(deftest "validate catches defisland with no body"
|
|
(let ((tree (sx-parse "(defisland ~counter)")))
|
|
(let ((result (validate tree)))
|
|
(assert (contains? result "ERROR"))
|
|
(assert (contains? result "defisland")))))
|
|
|
|
(deftest "validate passes valid letrec"
|
|
(let ((tree (sx-parse "(letrec ((f (fn () 1)) (g (fn () 2))) (f))")))
|
|
(assert-equal "OK" (validate tree))))
|
|
|
|
(deftest "validate nested issues"
|
|
(let ((tree (sx-parse "(div (defcomp ~bad))")))
|
|
(let ((result (validate tree)))
|
|
(assert (contains? result "ERROR")))))
|
|
|
|
(deftest "validate multiple issues"
|
|
(let ((tree (sx-parse "(do (defcomp ~a) (defisland ~b))")))
|
|
(let ((result (validate tree)))
|
|
;; Should have two errors
|
|
(assert (contains? result "defcomp"))
|
|
(assert (contains? result "defisland")))))
|
|
|
|
;; ========================================================================
|
|
;; node-summary
|
|
;; ========================================================================
|
|
|
|
(deftest "node-summary short list"
|
|
(let ((tree (sx-parse "(add 1 2)")))
|
|
(let ((result (node-summary (first tree))))
|
|
(assert-equal "(add 1 2)" result))))
|
|
|
|
(deftest "node-summary long list truncates"
|
|
(let ((tree (sx-parse "(fn (a b c d e f) body)")))
|
|
(let ((result (node-summary (first tree))))
|
|
(assert (contains? result "fn"))
|
|
(assert (contains? result "...")))))
|
|
|
|
(deftest "node-summary atom"
|
|
(assert-equal "42" (node-summary 42)))
|
|
|
|
;; ========================================================================
|
|
;; Real-world scenarios
|
|
;; ========================================================================
|
|
|
|
(deftest "annotate-tree on defisland"
|
|
(let ((tree (sx-parse "(defisland ~counter () (let ((count (signal 0))) (div (button count))))")))
|
|
(let ((result (annotate-tree tree)))
|
|
(assert (contains? result "defisland"))
|
|
(assert (contains? result "~counter"))
|
|
(assert (contains? result "let"))
|
|
(assert (contains? result "button")))))
|
|
|
|
(deftest "find-all finds letrec bindings by name"
|
|
(let ((tree (sx-parse "(letrec ((helper (fn () 1)) (main (fn () (helper)))) (main))")))
|
|
(let ((results (find-all tree "helper")))
|
|
;; Should find: the binding name, the call inside main
|
|
(assert (>= (len results) 2)))))
|
|
|
|
(deftest "validate detects letrec non-pair expression"
|
|
;; Simulate the original bug: a bare expression in the bindings list
|
|
(let ((tree (sx-parse "(letrec ((a (fn () nil)) (rebuild-preview 1) (b (fn () nil))) nil)")))
|
|
;; (rebuild-preview 1) looks like a binding pair, so validate won't flag it
|
|
;; BUT annotate-tree reveals the structure:
|
|
(let ((ann (annotate-tree tree)))
|
|
;; rebuild-preview should be at [0,1,1] as a binding pair
|
|
(assert (contains? ann "[0,1,1]"))
|
|
(assert (contains? ann "rebuild-preview")))))
|
|
|
|
(deftest "get-context on real component pattern"
|
|
(let ((tree (sx-parse "(defcomp ~layout (&key title) (html (head (title title)) (body (div :id \"app\" (main children)))))")))
|
|
;; body is at [0,3] (html), [0,3,2] (body), [0,3,2,1] (div), [0,3,2,1,3] (main)
|
|
(let ((result (get-context tree (list 0 3 2 1 3))))
|
|
(assert (contains? result "defcomp"))
|
|
(assert (contains? result "body"))
|
|
(assert (contains? result "main")))))
|
|
|
|
(deftest "summarise then read-subtree workflow"
|
|
;; The typical workflow: summarise to find region, then read-subtree to expand
|
|
(let ((tree (sx-parse "(defcomp ~page () (div (header (h1 \"Title\")) (main (p \"Content\") (p \"More\"))))")))
|
|
;; Step 1: summarise at depth 1 to find main
|
|
(let ((summary (summarise tree 1)))
|
|
(assert (contains? summary "div"))
|
|
;; Step 2: read-subtree on main — body is [0,3], div children start at [0,3,1]
|
|
(let ((detail (read-subtree tree (list 0 3 2))))
|
|
(assert (contains? detail "main"))
|
|
(assert (contains? detail "Content"))
|
|
(assert (contains? detail "More"))))))
|
|
|
|
;; ========================================================================
|
|
;; Phase 2: Edit operations
|
|
;; ========================================================================
|
|
|
|
;; -- list helpers --
|
|
|
|
(deftest "list-replace replaces at index"
|
|
(assert-equal (list 1 99 3) (list-replace (list 1 2 3) 1 99)))
|
|
|
|
(deftest "list-replace first"
|
|
(assert-equal (list 99 2 3) (list-replace (list 1 2 3) 0 99)))
|
|
|
|
(deftest "list-replace last"
|
|
(assert-equal (list 1 2 99) (list-replace (list 1 2 3) 2 99)))
|
|
|
|
(deftest "list-insert at start"
|
|
(assert-equal (list 0 1 2 3) (list-insert (list 1 2 3) 0 0)))
|
|
|
|
(deftest "list-insert at middle"
|
|
(assert-equal (list 1 99 2 3) (list-insert (list 1 2 3) 1 99)))
|
|
|
|
(deftest "list-insert at end"
|
|
(assert-equal (list 1 2 3 4) (list-insert (list 1 2 3) 3 4)))
|
|
|
|
(deftest "list-remove first"
|
|
(assert-equal (list 2 3) (list-remove (list 1 2 3) 0)))
|
|
|
|
(deftest "list-remove middle"
|
|
(assert-equal (list 1 3) (list-remove (list 1 2 3) 1)))
|
|
|
|
(deftest "list-remove last"
|
|
(assert-equal (list 1 2) (list-remove (list 1 2 3) 2)))
|
|
|
|
;; -- tree-set --
|
|
|
|
(deftest "tree-set replaces root child"
|
|
(let ((tree (sx-parse "(a b c)")))
|
|
(let ((result (tree-set tree (list 0 1) 99)))
|
|
(assert-equal 99 (navigate result (list 0 1))))))
|
|
|
|
(deftest "tree-set replaces nested child"
|
|
(let ((tree (sx-parse "(a (b 1 2) c)")))
|
|
(let ((result (tree-set tree (list 0 1 1) 99)))
|
|
(assert-equal 99 (navigate result (list 0 1 1)))
|
|
;; Other nodes unchanged
|
|
(assert-equal 2 (navigate result (list 0 1 2))))))
|
|
|
|
(deftest "tree-set invalid path returns nil"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(assert (nil? (tree-set tree (list 0 5) 99)))))
|
|
|
|
(deftest "tree-set preserves siblings"
|
|
(let ((tree (sx-parse "(div (span) (p) (em))")))
|
|
(let ((result (tree-set tree (list 0 2) (first (sx-parse "(strong)")))))
|
|
(assert-equal "span" (symbol-name (first (navigate result (list 0 1)))))
|
|
(assert-equal "strong" (symbol-name (first (navigate result (list 0 2)))))
|
|
(assert-equal "em" (symbol-name (first (navigate result (list 0 3))))))))
|
|
|
|
;; -- replace-node --
|
|
|
|
(deftest "replace-node replaces with parsed source"
|
|
(let ((tree (sx-parse "(div (span \"old\") (p \"keep\"))")))
|
|
(let ((result (replace-node tree (list 0 1) "(em \"new\")")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
;; The span should be replaced with em
|
|
(let ((replaced (navigate new-tree (list 0 1))))
|
|
(assert (list? replaced))
|
|
(assert-equal "em" (symbol-name (first replaced))))))))
|
|
|
|
(deftest "replace-node error on bad fragment"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (replace-node tree (list 0 1) "")))
|
|
(assert (not (nil? (get result "error")))))))
|
|
|
|
(deftest "replace-node error on bad path"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (replace-node tree (list 5) "(c)")))
|
|
(assert (not (nil? (get result "error"))))
|
|
(assert (contains? (get result "error") "not found")))))
|
|
|
|
(deftest "replace-node preserves rest of tree"
|
|
(let ((tree (sx-parse "(a 1 2 3)")))
|
|
(let ((result (replace-node tree (list 0 2) "99")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal 1 (navigate new-tree (list 0 1)))
|
|
(assert-equal 99 (navigate new-tree (list 0 2)))
|
|
(assert-equal 3 (navigate new-tree (list 0 3)))))))
|
|
|
|
(deftest "replace-node deep replacement"
|
|
(let ((tree (sx-parse "(a (b (c old)))")))
|
|
(let ((result (replace-node tree (list 0 1 1 1) "new-val")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal "new-val" (symbol-name (navigate new-tree (list 0 1 1 1))))))))
|
|
|
|
;; -- insert-child --
|
|
|
|
(deftest "insert-child adds at start"
|
|
(let ((tree (sx-parse "(div (p \"a\") (p \"b\"))")))
|
|
(let ((result (insert-child tree (list 0) 1 "(h1 \"title\")")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal "h1" (symbol-name (first (navigate new-tree (list 0 1)))))
|
|
(assert-equal "p" (symbol-name (first (navigate new-tree (list 0 2)))))))))
|
|
|
|
(deftest "insert-child adds at end"
|
|
(let ((tree (sx-parse "(div (p \"a\"))")))
|
|
(let ((result (insert-child tree (list 0) 2 "(p \"b\")")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal 3 (len (navigate new-tree (list 0))))))))
|
|
|
|
(deftest "insert-child error on non-list"
|
|
(let ((tree (sx-parse "(a \"hello\")")))
|
|
(let ((result (insert-child tree (list 0 1) 0 "(b)")))
|
|
(assert (not (nil? (get result "error")))))))
|
|
|
|
(deftest "insert-child error on bad index"
|
|
(let ((tree (sx-parse "(a b c)")))
|
|
(let ((result (insert-child tree (list 0) 99 "(d)")))
|
|
(assert (not (nil? (get result "error"))))
|
|
(assert (contains? (get result "error") "out of range")))))
|
|
|
|
;; -- delete-node --
|
|
|
|
(deftest "delete-node removes child"
|
|
(let ((tree (sx-parse "(div (span) (p) (em))")))
|
|
(let ((result (delete-node tree (list 0 2))))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal 3 (len (navigate new-tree (list 0))))
|
|
;; p is gone, em shifted to index 2
|
|
(assert-equal "em" (symbol-name (first (navigate new-tree (list 0 2)))))))))
|
|
|
|
(deftest "delete-node removes first child"
|
|
(let ((tree (sx-parse "(a b c d)")))
|
|
(let ((result (delete-node tree (list 0 1))))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal "c" (symbol-name (navigate new-tree (list 0 1))))))))
|
|
|
|
(deftest "delete-node error on root"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (delete-node tree (list))))
|
|
(assert (not (nil? (get result "error")))))))
|
|
|
|
(deftest "delete-node error on bad index"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (delete-node tree (list 0 5))))
|
|
(assert (not (nil? (get result "error")))))))
|
|
|
|
;; -- wrap-node --
|
|
|
|
(deftest "wrap-node wraps in new form"
|
|
(let ((tree (sx-parse "(div (p \"hello\"))")))
|
|
(let ((result (wrap-node tree (list 0 1) "(when visible _)")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(let ((wrapped (navigate new-tree (list 0 1))))
|
|
(assert-equal "when" (symbol-name (first wrapped)))
|
|
;; The original (p "hello") should be the _ replacement
|
|
(assert-equal "p" (symbol-name (first (nth wrapped 2)))))))))
|
|
|
|
(deftest "wrap-node error on missing placeholder"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (wrap-node tree (list 0 1) "(when cond)")))
|
|
(assert (not (nil? (get result "error"))))
|
|
(assert (contains? (get result "error") "placeholder")))))
|
|
|
|
(deftest "wrap-node error on bad path"
|
|
(let ((tree (sx-parse "(a b)")))
|
|
(let ((result (wrap-node tree (list 5) "(when _)")))
|
|
(assert (not (nil? (get result "error")))))))
|
|
|
|
(deftest "wrap-node preserves siblings"
|
|
(let ((tree (sx-parse "(div (span) (p \"target\") (em))")))
|
|
(let ((result (wrap-node tree (list 0 2) "(when show _)")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal "span" (symbol-name (first (navigate new-tree (list 0 1)))))
|
|
(assert-equal "when" (symbol-name (first (navigate new-tree (list 0 2)))))
|
|
(assert-equal "em" (symbol-name (first (navigate new-tree (list 0 3)))))))))
|
|
|
|
;; -- replace-placeholder --
|
|
|
|
(deftest "replace-placeholder in flat list"
|
|
(let ((tree (sx-parse "(when cond _)")))
|
|
(let ((result (replace-placeholder (first tree) 42)))
|
|
(assert-equal 42 (nth result 2)))))
|
|
|
|
(deftest "replace-placeholder nested"
|
|
(let ((tree (sx-parse "(div (when cond _))")))
|
|
(let ((result (replace-placeholder (first tree) 42)))
|
|
(assert-equal 42 (nth (nth result 1) 2)))))
|
|
|
|
(deftest "replace-placeholder only first occurrence"
|
|
(let ((tree (sx-parse "(a _ _)")))
|
|
(let ((result (replace-placeholder (first tree) 99)))
|
|
(assert-equal 99 (nth result 1))
|
|
;; Second _ should remain
|
|
(assert-equal "_" (symbol-name (nth result 2))))))
|
|
|
|
(deftest "replace-placeholder returns nil if no _"
|
|
(let ((tree (sx-parse "(a b c)")))
|
|
(assert (nil? (replace-placeholder (first tree) 42)))))
|
|
|
|
;; ========================================================================
|
|
;; End-to-end edit workflows
|
|
;; ========================================================================
|
|
|
|
(deftest "round-trip: replace then serialize"
|
|
(let ((tree (sx-parse "(defcomp ~card () (div (h2 \"old\")))")))
|
|
(let ((result (replace-node tree (list 0 3 1) "(h2 \"new\")")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((serialized (sx-serialize (first (get result "ok")))))
|
|
(assert (contains? serialized "new"))
|
|
(assert (not (contains? serialized "old")))))))
|
|
|
|
(deftest "delete then validate"
|
|
(let ((tree (sx-parse "(letrec ((a (fn () 1)) (b (fn () 2))) (a))")))
|
|
;; Delete second binding
|
|
(let ((result (delete-node tree (list 0 1 1))))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(assert-equal "OK" (validate (get result "ok"))))))
|
|
|
|
(deftest "insert then find"
|
|
(let ((tree (sx-parse "(div (p \"first\"))")))
|
|
(let ((result (insert-child tree (list 0) 2 "(p \"second\")")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((found (find-all (get result "ok") "second")))
|
|
(assert (>= (len found) 1))))))
|
|
|
|
(deftest "replace-node 6-level deep preserves full tree"
|
|
(let ((tree (sx-parse "(outer (a (b (c (d (e x y z) f g h i j k l) m n) o p) q r) s t)")))
|
|
(let ((result (replace-node tree (list 0 1 1 1 1 1 1) "replaced")))
|
|
(assert (not (nil? (get result "ok"))))
|
|
(let ((new-tree (get result "ok")))
|
|
(assert-equal "replaced" (symbol-name (navigate new-tree (list 0 1 1 1 1 1 1))))
|
|
(assert-equal 1 (len new-tree))
|
|
(let ((d-node (navigate new-tree (list 0 1 1 1 1))))
|
|
(assert-equal 9 (len d-node)))
|
|
(assert-equal "s" (symbol-name (navigate new-tree (list 0 2))))))))
|
|
|
|
|
|
(deftest "collect-free-symbols: let binds exclude variables"
|
|
(let ((tree (sx-parse "(let ((x 10)) (+ x y))")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (contains? syms "+"))
|
|
(assert (contains? syms "y"))
|
|
(assert (not (contains? syms "x"))))))
|
|
|
|
(deftest "collect-free-symbols: fn params excluded"
|
|
(let ((tree (sx-parse "(fn (a b) (+ a b c))")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (contains? syms "+"))
|
|
(assert (contains? syms "c"))
|
|
(assert (not (contains? syms "a")))
|
|
(assert (not (contains? syms "b"))))))
|
|
|
|
(deftest "collect-free-symbols: define name excluded"
|
|
(let ((tree (sx-parse "(define foo (+ bar 1))")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (contains? syms "+"))
|
|
(assert (contains? syms "bar"))
|
|
(assert (not (contains? syms "foo"))))))
|
|
|
|
(deftest "collect-free-symbols: letrec bindings visible in body"
|
|
(let ((tree (sx-parse "(letrec ((f (fn (x) (g x))) (g (fn (y) y))) (f 1))")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (not (contains? syms "f")))
|
|
(assert (not (contains? syms "g")))
|
|
(assert (not (contains? syms "x")))
|
|
(assert (not (contains? syms "y"))))))
|
|
|
|
(deftest "collect-free-symbols: quote skipped"
|
|
(let ((tree (sx-parse "(quote (foo bar baz))")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (empty? syms)))))
|
|
|
|
(deftest "collect-free-symbols: special forms not reported"
|
|
(let ((tree (sx-parse "(if (> x 0) (+ x 1) 0)")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (not (contains? syms "if")))
|
|
(assert (contains? syms ">"))
|
|
(assert (contains? syms "x"))
|
|
(assert (contains? syms "+")))))
|
|
|
|
(deftest "collect-free-symbols: defcomp params excluded"
|
|
(let ((tree (sx-parse "(defcomp ~card (&key title) (div title))")))
|
|
(let ((syms (collect-free-symbols (first tree))))
|
|
(assert (contains? syms "div"))
|
|
(assert (not (contains? syms "title"))))))
|
|
|
|
(deftest "native list-replace works at all positions"
|
|
(assert-equal (list 99 2 3) (list-replace (list 1 2 3) 0 99))
|
|
(assert-equal (list 1 99 3) (list-replace (list 1 2 3) 1 99))
|
|
(assert-equal (list 1 2 99) (list-replace (list 1 2 3) 2 99)))
|
|
|
|
(deftest "native navigate deep path"
|
|
(let ((tree (sx-parse "(a (b (c (d (e (f target))))))")))
|
|
(let ((result (navigate tree (list 0 1 1 1 1 1 1))))
|
|
(assert-equal "target" (symbol-name result)))))
|
|
|
|
(deftest "native navigate preserves structure"
|
|
(let ((tree (sx-parse "(outer (inner x y z) sibling)")))
|
|
(assert-equal "inner" (symbol-name (first (navigate tree (list 0 1)))))
|
|
(assert-equal "sibling" (symbol-name (navigate tree (list 0 2))))))
|
|
|
|
) |