rose-ash/sx/sx/sx-tools-demos.sx

;; 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 (~tw :tokens "space-y-3")
        (div (~tw :tokens "space-y-2")
          (label (~tw :tokens "text-sm font-medium text-stone-700") "Source")
          (textarea (~tw :tokens "w-full font-mono text-xs bg-stone-50 border border-stone-300 rounded p-2")
            :rows 6 :bind source))
        (div (~tw :tokens "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 (~tw :tokens "px-3 py-1 text-xs rounded bg-stone-700 text-white")
            :on-click (fn (e) (run-tool))
            "Run"))
        (pre (~tw :tokens "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))))))