Add interactive tree editor island (Phase 4) + MCP server fixes
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:
192
sx/sx/sx-tools-editor.sx
Normal file
192
sx/sx/sx-tools-editor.sx
Normal 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)))))))))
|
||||
@@ -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:")
|
||||
|
||||
Reference in New Issue
Block a user