coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add interactive tree editor island (Phase 4) + MCP server fixes

Browse Source 
Phase 4: defisland ~sx-tools/tree-editor — interactive tree viewer
embedded in the SX Tools page. Features:
- Textarea with :bind for SX source input
- Parse button to re-parse on demand
- Tree view: annotated tree with path labels, clickable nodes
- Context view: enclosing chain from root to selected node
- Validate view: structural integrity checks (catches missing body etc.)

MCP server fixes: added ident-start?, ident-char?, make-keyword,
escape-string, sx-expr-source — needed by parser.sx when loaded
into the MCP evaluator.

Also: .mcp.json for Claude Code MCP server config, CLAUDE.md protocol
for structural .sx file editing.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-25 20:11:27 +00:00
parent 934604c2bd
commit 6d0e512f19
5 changed files with 290 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
.mcp.json Normal file
View File

@@ -0,0 +1,8 @@
{
"mcpServers": {
"sx-tree": {
"type": "stdio",
"command": "./hosts/ocaml/_build/default/bin/mcp_tree.exe"
}
}
}

48
CLAUDE.md
View File

@@ -2,6 +2,54 @@
Cooperative web platform: federated content, commerce, events, and media processing. Each domain runs as an independent Quart microservice with its own database, communicating via HMAC-signed internal HTTP and ActivityPub events.
## S-expression files — reading and editing protocol
**Never use `str_replace` or `write_file` on `.sx` or `.sxc` files for structural edits.** These tools operate on text and have no understanding of tree structure. Bracket mismatches produced this way corrupt files silently — a single extra `)` caused the home page to go blank for an hour (25 March 2026).
Use the `sx-tree` MCP server tools instead. These operate on the parsed tree, not raw text. Bracket errors are impossible by construction.
### Before doing anything in an `.sx` file
1. Call `sx_summarise` to get a structural overview of the whole file
2. Call `sx_read_subtree` on the region you intend to work in
3. Call `sx_get_context` on specific nodes to understand their position
4. Call `sx_find_all` to locate definitions or patterns by name
**Never proceed to an edit without first establishing where you are in the tree using the comprehension tools.**
### For every s-expression edit
1. Call `sx_read_subtree` on the target region to confirm the correct path
2. Call `sx_replace_node` / `sx_insert_child` / `sx_delete_node` / `sx_wrap_node`
3. Call `sx_validate` to confirm structural integrity
4. Call `sx_read_subtree` again on the edited region to verify the result
### On failure
Read the error carefully. Fragment errors give the parse failure in the new source. Path errors tell you which segment was not found. Fix the specific problem and retry the tree edit. **Never fall back to raw file writes.**
### When raw file access is acceptable
- Searching for a string literal or reading prose content with `Read` is fine
- Creating a **new** `.sx` file with `Write` is fine (there's no existing tree to corrupt)
- Any question about structure, nesting, or tree position goes through the tree tools
### Available MCP tools (sx-tree server)
| Tool | Purpose |
|------|---------|
| `sx_read_tree` | Full annotated tree with path labels |
| `sx_summarise` | Folded overview at configurable depth |
| `sx_read_subtree` | Expand a specific subtree by path |
| `sx_get_context` | Enclosing chain from root to target |
| `sx_find_all` | Search by pattern, returns paths |
| `sx_get_siblings` | Siblings of a node with target marked |
| `sx_validate` | Structural integrity checks |
| `sx_replace_node` | Replace node at path with new source |
| `sx_insert_child` | Insert child at index in a list |
| `sx_delete_node` | Remove node, siblings shift |
| `sx_wrap_node` | Wrap in template with `_` placeholder |
## Deployment
- **Do NOT push** until explicitly told to. Pushes reload code to dev automatically.

37
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -61,6 +61,43 @@ let setup_env () =
bind "identical?" (fun args -> match args with
| [a; b] -> Bool (a == b)
| _ -> Bool false);
(* Character classification for SX parser.sx *)
bind "ident-start?" (fun args -> match args with
| [String s] when String.length s = 1 ->
let c = s.[0] in
Bool ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
c = '_' || c = '~' || c = '*' || c = '+' || c = '-' ||
c = '>' || c = '<' || c = '=' || c = '/' || c = '!' ||
c = '?' || c = '&' || c = '@' || c = '^' || c = '%' ||
Char.code c > 127)
| _ -> Bool false);
bind "ident-char?" (fun args -> match args with
| [String s] when String.length s = 1 ->
let c = s.[0] in
Bool ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
(c >= '0' && c <= '9') ||
c = '_' || c = '~' || c = '*' || c = '+' || c = '-' ||
c = '>' || c = '<' || c = '=' || c = '/' || c = '!' ||
c = '?' || c = '&' || c = '.' || c = ':' || c = '#' ||
c = ',' || c = '@' || c = '^' || c = '%' ||
Char.code c > 127)
| _ -> Bool false);
bind "make-keyword" (fun args -> match args with
| [String s] -> Keyword s | _ -> Nil);
bind "escape-string" (fun args -> match args with
| [String s] ->
let buf = Buffer.create (String.length s) in
String.iter (fun c -> match c with
| '"' -> Buffer.add_string buf "\\\""
| '\\' -> Buffer.add_string buf "\\\\"
| '\n' -> Buffer.add_string buf "\\n"
| '\t' -> Buffer.add_string buf "\\t"
| '\r' -> Buffer.add_string buf "\\r"
| c -> Buffer.add_char buf c) s;
String (Buffer.contents buf)
| _ -> String "");
bind "sx-expr-source" (fun args -> match args with
| [SxExpr s] -> String s | _ -> String "");
(* Runtime functions needed by tree-tools *)
bind "symbol-name" (fun args -> match args with
| [Symbol s] -> String s | _ -> String "");

192
sx/sx/sx-tools-editor.sx Normal file
View File

@@ -0,0 +1,192 @@
;; SX Tools — Interactive tree editor island
;; Demonstrates the tree comprehension tools on user-provided SX source.
(defisland ~sx-tools/tree-editor ()
(let ((source (signal "(defcomp ~card (&key title subtitle)\n (div :class \"card\"\n (h2 title)\n (when subtitle\n (p :class \"sub\" subtitle))))"))
(view-mode (signal "tree"))
(selected-path (signal nil))
(parsed (signal nil)))
;; --- Inline tree display functions (pure, no lib dependency) ---
(letrec
((fmt-path (fn (path)
(str "[" (join "," (map str path)) "]")))
(node-disp (fn (node)
(cond
(nil? node) "nil"
(= (type-of node) "symbol") (symbol-name node)
(= (type-of node) "keyword") (str ":" (keyword-name node))
(string? node)
(let ((s (if (> (len node) 35) (str (slice node 0 32) "...") node)))
(str "\"" s "\""))
(number? node) (str node)
(= (type-of node) "boolean") (if node "true" "false")
(list? node)
(if (empty? node) "()"
(str "(" (node-disp (first node))
(if (> (len node) 1) " ..." "") ")"))
:else (str node))))
(is-compact (fn (node)
(and (list? node)
(<= (len node) 4)
(not (some (fn (c) (list? c)) (rest node))))))
;; Build a list of {path, text, depth, is-list, expandable} entries
(build-entries (fn (node path depth result)
(if (list? node)
(if (empty? node)
(append! result {"path" path "text" "()" "depth" depth "is-list" false "expandable" false})
(if (is-compact node)
(append! result {"path" path "text" (str "(" (join " " (map node-disp node)) ")") "depth" depth "is-list" true "expandable" false})
(do
(append! result {"path" path "text" (str "(" (node-disp (first node))) "depth" depth "is-list" true "expandable" true})
(for-each (fn (i)
(build-entries (nth node i) (concat path (list i)) (+ depth 1) result))
(range 1 (len node))))))
(append! result {"path" path "text" (node-disp node) "depth" depth "is-list" false "expandable" false}))))
;; Navigate to a node by path
(nav (fn (tree path)
(reduce
(fn (current idx)
(if (or (nil? current) (not (list? current)) (>= idx (len current)))
nil
(nth current idx)))
tree
path)))
;; Build context chain for a path
(build-context (fn (tree path)
(let ((result (list)))
(for-each (fn (depth)
(let ((prefix (slice path 0 (+ depth 1)))
(node (nav tree prefix)))
(when (not (nil? node))
(let ((is-target (= (+ depth 1) (len path))))
(append! result
{"path" prefix
"text" (if (list? node)
(if (empty? node) "()"
(let ((head (node-disp (first node))))
(if (> (len node) 3)
(str "(" head " " (node-disp (nth node 1)) " ...)")
(str "(" (join " " (map node-disp node)) ")"))))
(node-disp node))
"is-target" is-target
"depth" depth})))))
(range 0 (len path)))
result)))
;; Simple validate
(do-validate (fn (tree)
(let ((errors (list)))
(letrec
((check (fn (node path)
(when (list? node)
(when (not (empty? node))
(let ((head (first node)))
(when (and (= (type-of head) "symbol")
(or (= (symbol-name head) "letrec"))
(>= (len node) 2))
(let ((bindings (nth node 1)))
(when (list? bindings)
(for-each (fn (i)
(let ((pair (nth bindings i)))
(when (not (and (list? pair) (>= (len pair) 2)
(= (type-of (first pair)) "symbol")))
(append! errors (str "Binding " i " at " (fmt-path (concat path (list 1 i))) " is not a (name value) pair")))))
(range 0 (len bindings))))))
(when (and (= (type-of head) "symbol")
(or (= (symbol-name head) "defcomp")
(= (symbol-name head) "defisland")))
(when (< (len node) 4)
(append! errors (str (symbol-name head) " at " (fmt-path path) " missing body"))))))
(for-each (fn (i)
(check (nth node i) (concat path (list i))))
(range 0 (len node)))))))
(for-each (fn (i) (check (nth tree i) (list i))) (range 0 (len tree))))
(if (empty? errors) "OK" (join "\n" errors))))))
;; Initial parse
(reset! parsed (sx-parse (deref source)))
;; --- Render ---
(div :class "space-y-4"
;; Input area
(div :class "space-y-2"
(label :class "text-sm font-medium text-stone-700" "SX Source")
(textarea
:class "w-full font-mono text-xs bg-stone-50 border border-stone-200 rounded p-3 leading-relaxed"
:rows 6
:bind source))
;; Parse button + mode selector
(div :class "flex gap-2 items-center"
(button
:class "px-3 py-1 text-xs rounded bg-stone-700 text-white hover:bg-stone-800"
:on-click (fn (e)
(reset! parsed (sx-parse (deref source)))
(reset! selected-path nil))
"Parse")
(for-each (fn (mode)
(button
:class (str "px-3 py-1 text-xs rounded border transition-colors "
(if (= (deref view-mode) mode)
"bg-violet-600 text-white border-violet-600"
"bg-white text-stone-600 border-stone-200 hover:border-violet-300"))
:on-click (fn (e) (reset! view-mode mode))
mode))
(list "tree" "context" "validate")))
;; Output area
(if (or (nil? (deref parsed)) (empty? (deref parsed)))
(div :class "text-red-500 text-sm font-mono p-3 bg-red-50 rounded"
"Parse error — check your s-expression syntax")
(div :class "bg-stone-50 rounded border border-stone-200 p-3 font-mono text-xs leading-relaxed overflow-x-auto"
;; TREE VIEW
(when (= (deref view-mode) "tree")
(let ((entries (list))
(tree (deref parsed)))
(for-each (fn (i) (build-entries (nth tree i) (list i) 0 entries))
(range 0 (len tree)))
(div :class "space-y-0"
(map (fn (entry)
(let ((path (get entry "path"))
(sel (deref selected-path))
(is-selected (and (not (nil? sel)) (= (fmt-path sel) (fmt-path path)))))
(div
:class (str "py-0.5 cursor-pointer hover:bg-violet-50 rounded px-1 "
(if is-selected "bg-violet-100" ""))
:style (str "padding-left:" (* (get entry "depth") 16) "px")
:on-click (fn (e) (reset! selected-path path))
(span :class "text-stone-400 mr-2 select-none" (fmt-path path))
(span :class (if (get entry "is-list") "text-sky-700" "text-stone-600")
(get entry "text")))))
entries))))
;; CONTEXT VIEW
(when (= (deref view-mode) "context")
(if (nil? (deref selected-path))
(p :class "text-stone-400 italic" "Click a node in tree view to see its context")
(let ((ctx (build-context (deref parsed) (deref selected-path))))
(div :class "space-y-1"
(map (fn (item)
(div
:style (str "padding-left:" (* (get item "depth") 16) "px")
:class (if (get item "is-target") "text-violet-700 font-semibold" "text-stone-600")
(span :class "text-stone-400 mr-2"
(if (get item "is-target") "\u2192 " " ")
(fmt-path (get item "path")))
(span (get item "text"))))
ctx)))))
;; VALIDATE VIEW
(when (= (deref view-mode) "validate")
(let ((result (do-validate (deref parsed))))
(div :class (if (= result "OK") "text-emerald-600" "text-amber-600 whitespace-pre-wrap")
result)))))))))

5
sx/sx/sx-tools.sx
View File

@@ -195,6 +195,11 @@
(h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 5 — Integration and iteration")
(p "Write the " (code "CLAUDE.md") " protocol. Run real tasks with Claude Code — both reading and editing. Observe which comprehension tools Claude actually reaches for. Observe where it still makes structural errors. Iterate on output formats and add any missing tools. The output formats deserve careful design based on observed behaviour, not just on what seems reasonable in advance."))
;; -----------------------------------------------------------------
(~docs/section :title "Try it" :id "try-it"
(p "Paste or edit SX source below. The tree view shows every node with its path — click a node to select it, then switch to context view to see the enclosing chain.")
(~sx-tools/tree-editor))
;; -----------------------------------------------------------------
(~docs/section :title "What changes" :id "what-changes"
(p "With SX Tools, the debugging session that found the home-stepper bug would not have happened. The workflow would have been:")