Add SX tree tools: comprehension, editing, and MCP server
Phase 1-3 of the SX Tools plan — structural reading, editing, and
MCP server for .sx files.
lib/tree-tools.sx — Pure SX functions for tree comprehension and editing:
Comprehension: annotate-tree, summarise, read-subtree, get-context,
find-all, get-siblings, validate, navigate
Editing: replace-node, insert-child, delete-node, wrap-node, tree-set
Helpers: list-replace, list-insert, list-remove, replace-placeholder
lib/tests/test-tree-tools.sx — 107 tests covering all functions.
hosts/ocaml/bin/mcp_tree.ml — MCP server (stdio JSON-RPC) exposing
11 tools. Loads tree-tools.sx into the OCaml evaluator, parses .sx
files with the native parser, calls SX functions for tree operations.
The MCP server can be configured in Claude Code's settings.json as:
"mcpServers": { "sx-tree": { "command": "path/to/mcp_tree.exe" } }
1429 tests passing (1322 existing + 107 new tree-tools).
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
675
lib/tests/test-tree-tools.sx
Normal file
675
lib/tests/test-tree-tools.sx
Normal file
@@ -0,0 +1,675 @@
|
||||
;; ==========================================================================
|
||||
;; 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))))))
|
||||
)
|
||||
Reference in New Issue
Block a user