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

Add interactive tool playground to sx-tools page

Browse Source 
New defisland ~sx-tools/tool-playground: paste SX source, click a tool
button, see the output. 7 tools run client-side in the browser:
summarise, read-tree, find-all, validate, get-context, serialize,
hypersx.

Each uses the same SX functions the MCP server uses: sx-parse for
parsing, tree walking for annotation/summarise/find, sx-serialize for
round-trip, sx->hypersx for alternative syntax.

Pre-loaded with a sample defcomp. Users can paste any SX and explore
all the comprehension tools interactively.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-26 08:34:20 +00:00
parent b98e5b83de
commit dc72aac5b1
2 changed files with 129 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
sx/sx/sx-tools-demos.sx Normal file
View File

@@ -0,0 +1,128 @@
;; Interactive demos for sx-tree tools.
;; Each demo runs client-side using the same SX functions the MCP server uses.
(defisland ~sx-tools/tool-playground ()
(let ((source (signal "(defcomp ~card (&key title subtitle &rest children)\n (div :class \"card\"\n (h2 title)\n (when subtitle (p :class \"sub\" subtitle))\n children))"))
(tool (signal "summarise"))
(output (signal ""))
(parsed (signal nil)))
(letrec
((do-parse (fn ()
(reset! parsed (sx-parse (deref source)))))
(fmt-path (fn (path)
(str "[" (join "," (map str path)) "]")))
(node-preview (fn (node depth)
(cond
(nil? node) "nil"
(string? node) (str "\"" (if (> (len node) 30) (str (substring node 0 30) "...") node) "\"")
(number? node) (str node)
(= (type-of node) "boolean") (if node "true" "false")
(= (type-of node) "symbol") (symbol-name node)
(= (type-of node) "keyword") (str ":" (keyword-name node))
(list? node) (if (empty? node) "()"
(str "(" (node-preview (first node) 0)
(if (> (len node) 1) (str " ... " (len node) " children") "") ")"))
:else (str node))))
(summarise-node (fn (node path depth max-depth)
(if (not (list? node))
(str (fmt-path path) " " (node-preview node 0) "\n")
(if (or (empty? node) (>= depth max-depth))
(str (fmt-path path) " " (node-preview node 0) "\n")
(str (fmt-path path) " (" (node-preview (first node) 0) " ... " (len node) " children)\n"
(join "" (map-indexed (fn (i child)
(summarise-node child (concat path (list (+ i 1))) (+ depth 1) max-depth))
(rest node))))))))
(annotate-node (fn (node path depth)
(if (not (list? node))
(str (fmt-path path) " " (node-preview node 0) "\n")
(if (empty? node) (str (fmt-path path) " ()\n")
(str (fmt-path path) " (" (node-preview (first node) 0)
(if (and (<= (len node) 3) (not (some list? (rest node))))
(str " " (join " " (map (fn (c) (node-preview c 0)) (rest node))) ")\n")
(str "\n" (join "" (map-indexed (fn (i child)
(annotate-node child (concat path (list (+ i 1))) (+ depth 1)))
(rest node))) ")\n")))))))
(find-pattern (fn (tree pattern path results)
(when (list? tree)
(when (and (not (empty? tree))
(= (type-of (first tree)) "symbol")
(contains? (symbol-name (first tree)) pattern))
(append! results (str (fmt-path path) " " (node-preview tree 0))))
(for-each (fn (i)
(let ((child (nth tree i)))
(when (list? child)
(find-pattern child pattern (concat path (list i)) results))))
(range 0 (len tree))))))
(get-context (fn (tree path)
(let ((result (list)))
(for-each (fn (depth)
(let ((prefix (slice path 0 (+ depth 1)))
(node (reduce (fn (cur idx) (if (and (list? cur) (< idx (len cur))) (nth cur idx) nil)) tree prefix)))
(when node
(append! result (str (if (= depth (- (len path) 1)) "→ " " ")
(fmt-path prefix) " " (node-preview node 0))))))
(range 0 (len path)))
result)))
(run-tool (fn ()
(do-parse)
(let ((tree (deref parsed))
(t (deref tool)))
(when tree
(reset! output
(cond
(= t "summarise")
(join "" (map-indexed (fn (i expr)
(summarise-node expr (list i) 0 2))
tree))
(= t "read-tree")
(join "" (map-indexed (fn (i expr)
(annotate-node expr (list i) 0))
tree))
(= t "find-all")
(let ((results (list)))
(for-each (fn (i) (find-pattern (nth tree i) "def" (list i) results))
(range 0 (len tree)))
(if (empty? results) "No matches for \"def\""
(join "\n" results)))
(= t "validate")
(if (and tree (not (empty? tree))) "OK — structurally valid" "Parse error")
(= t "get-context")
(let ((ctx (get-context (first tree) (list 2))))
(if (empty? ctx) "Path (0 2) not found"
(join "\n" ctx)))
(= t "serialize")
(join "\n\n" (map sx-serialize tree))
(= t "hypersx")
(sx->hypersx tree)
:else "Select a tool")))))))
(run-tool)
(div :class "space-y-3"
(div :class "space-y-2"
(label :class "text-sm font-medium text-stone-700" "Source")
(textarea :class "w-full font-mono text-xs bg-stone-50 border border-stone-300 rounded p-2"
:rows 6 :bind source))
(div :class "flex gap-2 flex-wrap items-center"
(for-each (fn (t)
(button
:class (str "px-3 py-1 text-xs rounded border transition "
(if (= (deref tool) t)
"bg-violet-600 text-white border-violet-600"
"bg-white text-stone-600 border-stone-300 hover:border-violet-400"))
:on-click (fn (e) (reset! tool t) (run-tool))
t))
(list "summarise" "read-tree" "find-all" "validate" "get-context" "serialize" "hypersx"))
(button :class "px-3 py-1 text-xs rounded bg-stone-700 text-white"
:on-click (fn (e) (run-tool))
"Run"))
(pre :class "font-mono text-xs text-stone-700 bg-stone-50 border border-stone-200 rounded p-3 whitespace-pre-wrap overflow-x-auto max-h-64 overflow-y-auto"
(deref output))))))

2
sx/sx/sx-tools.sx
View File

File diff suppressed because one or more lines are too long