rose-ash/sx/sx/home-stepper.sx

(defisland ~home/stepper ()
  (let ((source "(div (~cssx/tw :tokens \"text-center\")\n  (h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")\n    (span (~cssx/tw :tokens \"text-rose-500\") \"the \")\n    (span (~cssx/tw :tokens \"text-amber-500\") \"joy \")\n    (span (~cssx/tw :tokens \"text-emerald-500\") \"of \")\n    (span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")
        (steps (signal (list)))
        (step-idx (signal 9))
        (dom-stack-sig (signal (list)))
        (code-tokens (signal (list)))
        (code-spans (list)))
    (letrec
      ((split-tag (fn (expr result)
         (cond
           (not (list? expr))
             (append! result {"type" "leaf" "expr" expr})
           (empty? expr) nil
           (not (= (type-of (first expr)) "symbol"))
             (append! result {"type" "leaf" "expr" expr})
           (is-html-tag? (symbol-name (first expr)))
             (let ((ctag (symbol-name (first expr)))
                   (cargs (rest expr))
                   (cch (list))
                   (cat (list))
                   (spreads (list))
                   (ckw false))
               (for-each (fn (a)
                 (cond
                   (= (type-of a) "keyword") (do (set! ckw true) (append! cat a))
                   ckw (do (set! ckw false) (append! cat a))
                   (and (list? a) (not (empty? a))
                        (= (type-of (first a)) "symbol")
                        (starts-with? (symbol-name (first a)) "~"))
                     (do (set! ckw false) (append! spreads a))
                   :else (do (set! ckw false) (append! cch a))))
                 cargs)
               (append! result {"type" "open" "tag" ctag "attrs" cat "spreads" spreads})
               (for-each (fn (c) (split-tag c result)) cch)
               (append! result {"type" "close" "tag" ctag}))
           :else
             (append! result {"type" "expr" "expr" expr}))))
       (build-code-tokens (fn (expr tokens step-ref indent)
         (cond
           (string? expr)
             (do (append! tokens {"text" (str "\"" expr "\"") "cls" "text-emerald-700" "step" (get step-ref "v")})
                 (dict-set! step-ref "v" (+ (get step-ref "v") 1)))
           (number? expr)
             (do (append! tokens {"text" (str expr) "cls" "text-amber-700" "step" (get step-ref "v")})
                 (dict-set! step-ref "v" (+ (get step-ref "v") 1)))
           (= (type-of expr) "keyword")
             (append! tokens {"text" (str ":" (keyword-name expr)) "cls" "text-violet-600" "step" (get step-ref "v")})
           (= (type-of expr) "symbol")
             (let ((name (symbol-name expr)))
               (append! tokens {"text" name "cls"
                 (cond
                   (is-html-tag? name) "text-sky-700 font-semibold"
                   (starts-with? name "~") "text-rose-600 font-semibold"
                   :else "text-stone-700")
                 "step" (get step-ref "v")}))
           (list? expr)
             (when (not (empty? expr))
               (let ((head (first expr))
                     (is-tag (and (= (type-of head) "symbol") (is-html-tag? (symbol-name head))))
                     (is-comp (and (= (type-of head) "symbol") (starts-with? (symbol-name head) "~")))
                     (open-step (get step-ref "v")))
                 (append! tokens {"text" "(" "cls" "text-stone-400" "step" open-step})
                 (build-code-tokens head tokens step-ref indent)
                 (when is-tag
                   (dict-set! step-ref "v" (+ (get step-ref "v") 1)))
                 (for-each (fn (a)
                   (let ((is-child (and (list? a) (not (empty? a))
                                        (= (type-of (first a)) "symbol")
                                        (or (is-html-tag? (symbol-name (first a)))
                                            (starts-with? (symbol-name (first a)) "~"))))
                         (is-spread (and (list? a) (not (empty? a))
                                         (= (type-of (first a)) "symbol")
                                         (starts-with? (symbol-name (first a)) "~"))))
                     (if is-spread
                       ;; Component spread: save counter, process, restore
                       ;; All tokens inside share parent open-step
                       (let ((saved (get step-ref "v"))
                               (saved-tokens-len (len tokens)))
                         (append! tokens {"text" " " "cls" "" "step" -1})
                         (build-code-tokens a tokens step-ref indent)
                         ;; Mark all tokens added during spread as spread tokens
                         (let mark-loop ((j saved-tokens-len))
                           (when (< j (len tokens))
                             (dict-set! (nth tokens j) "spread" true)
                             (mark-loop (+ j 1))))
                         (dict-set! step-ref "v" saved))
                       (if (and is-tag is-child)
                         (do (append! tokens {"text" (str "\n" (join "" (map (fn (_) "  ") (range 0 (+ indent 1))))) "cls" "" "step" -1})
                             (build-code-tokens a tokens step-ref (+ indent 1)))
                         (do (append! tokens {"text" " " "cls" "" "step" -1})
                             (build-code-tokens a tokens step-ref indent))))))
                   (rest expr))
                 (append! tokens {"text" ")" "cls" "text-stone-400" "step" open-step})
                 (when is-tag
                   (dict-set! step-ref "v" (+ (get step-ref "v") 1)))))
           :else nil)))
       (get-preview (fn () (dom-query "[data-sx-lake=\"home-preview\"]")))
       (get-code-view (fn () (dom-query "[data-sx-lake=\"code-view\"]")))
       (get-stack (fn () (deref dom-stack-sig)))
       (set-stack (fn (v) (reset! dom-stack-sig v)))
       (push-stack (fn (el) (reset! dom-stack-sig (append (deref dom-stack-sig) (list el)))))
       (pop-stack (fn ()
         (let ((s (deref dom-stack-sig)))
           (when (> (len s) 1)
             (reset! dom-stack-sig (slice s 0 (- (len s) 1)))))))
       (build-code-dom (fn ()
         (when (and (empty? code-spans) (not (empty? (deref code-tokens))))
           (let ((code-el (get-code-view)))
             (when code-el
               (dom-set-prop code-el "innerHTML" "")
               (for-each (fn (tok)
                 (let ((sp (dom-create-element "span" nil)))
                   (dom-set-attr sp "class" (get tok "cls"))
                   (dom-set-prop sp "textContent" (get tok "text"))
                   (dom-append code-el sp)
                   (append! code-spans (dict "el" sp "step" (get tok "step") "cls" (get tok "cls") "spread" (get tok "spread")))))
                 (deref code-tokens)))))))
       (update-code-highlight (fn ()
         (let ((cur (deref step-idx)))
           (for-each (fn (s)
             (let ((step-num (get s "step"))
                   (el (get s "el"))
                   (base (get s "cls")))
               (when (not (= step-num -1))
                 (dom-set-attr el "class"
                   (str base
                     (let ((is-spread (get s "spread")))
                     (cond
                       (and (= step-num cur) is-spread) " opacity-60"
                       (= step-num cur) " bg-amber-100 rounded px-0.5 font-bold text-sm"
                       (and (< step-num cur) is-spread) " opacity-60"
                       (< step-num cur) " font-bold text-xs"
                       :else " opacity-40")))))))
             code-spans))))
       (do-step (fn ()
         (build-code-dom)
         (when (< (deref step-idx) (len (deref steps)))
           (when (empty? (get-stack))
             (let ((p (get-preview)))
               (when p (set-stack (list p)))))
           (let ((step (nth (deref steps) (deref step-idx)))
                 (step-type (get step "type"))
                 (parent (if (empty? (get-stack)) (get-preview) (last (get-stack)))))
             (cond
               (= step-type "open")
                 (let ((el (dom-create-element (get step "tag") nil))
                       (attrs (get step "attrs"))
                       (spreads (or (get step "spreads") (list))))
                   (let loop ((i 0))
                     (when (< i (len attrs))
                       (dom-set-attr el (keyword-name (nth attrs i)) (nth attrs (+ i 1)))
                       (loop (+ i 2))))
                   (for-each (fn (sp)
                     (let ((result (eval-expr sp (make-env))))
                       (when (and result (spread? result))
                         (let ((sattrs (spread-attrs result)))
                           (for-each (fn (k)
                             (if (= k "class")
                               (dom-set-attr el "class"
                                 (str (or (dom-get-attr el "class") "") " " (get sattrs k)))
                               (dom-set-attr el k (get sattrs k))))
                             (keys sattrs))))))
                     spreads)
                   (when parent (dom-append parent el))
                   (push-stack el))
               (= step-type "close")
                 (pop-stack)
               (= step-type "leaf")
                 (when parent
                   (let ((val (get step "expr")))
                     (dom-append parent (create-text-node (if (string? val) val (str val))))))
               (= step-type "expr")
                 (let ((rendered (render-to-dom (get step "expr") (make-env) nil)))
                   (when (and parent rendered)
                     (dom-append parent rendered)))))
           (swap! step-idx inc)
           (update-code-highlight)
           (local-storage-set "sx-home-stepper" (freeze-to-sx "home-stepper")))))
       (do-back (fn ()
         (when (> (deref step-idx) 0)
           (let ((target (- (deref step-idx) 1))
                 (container (get-preview)))
             (when container (dom-set-prop container "innerHTML" ""))
             (set-stack (list (get-preview)))
             (reset! step-idx 0)
             (for-each (fn (_) (do-step)) (slice (deref steps) 0 target))
             (local-storage-set "sx-home-stepper" (freeze-to-sx "home-stepper")))))))
      ;; Freeze scope for persistence
      (freeze-scope "home-stepper" (fn ()
        (freeze-signal "step" step-idx)))
      ;; Restore from localStorage on mount
      (let ((saved (local-storage-get "sx-home-stepper")))
        (when saved
          (thaw-from-sx saved)
          ;; Validate — reset to default if out of range
          (when (or (< (deref step-idx) 0) (> (deref step-idx) 16))
            (reset! step-idx 9))))
      ;; Parse source eagerly (pure computation — works in SSR and client)
      (let ((parsed (sx-parse source)))
        (when (not (empty? parsed))
          (let ((result (list))
                (step-ref (dict "v" 0)))
            (split-tag (first parsed) result)
            (reset! steps result)
            (let ((tokens (list)))
              (dict-set! step-ref "v" 0)
              (build-code-tokens (first parsed) tokens step-ref 0)
              (reset! code-tokens tokens)))))
      ;; DOM build via effect (client-only — needs live DOM)
      (let ((_eff (effect (fn ()
              (schedule-idle (fn ()
                (build-code-dom)
                (let ((preview (get-preview)))
                  (when preview (dom-set-prop preview "innerHTML" "")))
                (let ((target (deref step-idx)))
                  (reset! step-idx 0)
                  (set-stack (list (get-preview)))
                  (for-each (fn (_) (do-step)) (slice (deref steps) 0 target)))
                (update-code-highlight)
                (run-post-render-hooks)))))))
      (div :class "space-y-4"
        ;; Code view lake — SSR renders tokenized code with highlighting
        (div (~cssx/tw :tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
          :style "font-size:0.5rem"
          (lake :id "code-view"
            (map (fn (tok)
              (let ((step (get tok "step"))
                    (cur (deref step-idx))
                    (active (<= step cur))
                    (cls (str (get tok "cls")
                              (if (and active (>= step 0) (not (get tok "spread")))
                                " font-bold text-xs"
                                (if (and (not active) (>= step 0) (not (get tok "spread")))
                                  " opacity-40"
                                  "")))))
                (span :class cls (get tok "text"))))
              (deref code-tokens))))
        ;; Controls
        (div :class "flex items-center justify-center gap-2 md:gap-3"
          (button :on-click (fn (e) (do-back))
            :class (str "px-2 py-1 rounded text-3xl "
                     (if (> (deref step-idx) 0)
                       "text-stone-600 hover:text-stone-800 hover:bg-stone-100"
                       "text-stone-300 cursor-not-allowed"))
            "\u25c0")
          (span :class "text-sm text-stone-500 font-mono tabular-nums"
            (deref step-idx) " / " (len (deref steps)))
          (button :on-click (fn (e) (do-step))
            :class (str "px-2 py-1 rounded text-3xl "
                     (if (< (deref step-idx) (len (deref steps)))
                       "text-violet-600 hover:text-violet-800 hover:bg-violet-50"
                       "text-violet-300 cursor-not-allowed"))
            "\u25b6"))
        ;; Live preview lake — SSR shows the final rendered result
        (lake :id "home-preview"
          (div (~cssx/tw :tokens "text-center")
            (h1 (~cssx/tw :tokens "text-3xl font-bold mb-2")
              (span (~cssx/tw :tokens "text-rose-500") "the ")
              (span (~cssx/tw :tokens "text-amber-500") "joy ")
              (span (~cssx/tw :tokens "text-emerald-500") "of ")
              (span (~cssx/tw :tokens "text-violet-600 text-4xl") "sx")))))))))