coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
85702e92c9e975ee0fb1c0bb1c3dc1e6c5f3af5c
rose-ash/lib/tests/test-tree-tools.sx
giles 934604c2bd 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>
2026-03-25 19:16:41 +00:00

676 lines
27 KiB
Plaintext
Raw Blame History

;; ==========================================================================
;; 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 View Git Blame Copy Permalink