(defisland
  ()
  (let
    ((source "(div (~tw :tokens \"text-center\")\n  (h1 (~tw :tokens \"text-3xl font-bold mb-2\")\n    (span (~tw :tokens \"text-rose-500\") \"the \")\n    (span (~tw :tokens \"text-amber-500\") \"joy \")\n    (span (~tw :tokens \"text-emerald-500\") \"of \")\n    (span (~tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")
      (steps (signal (list)))
      (store
        (if
          (client?)
          (def-store
            "home-stepper"
            (fn
              ()
              (let
                ((raw (host-get (host-global "document") "cookie"))
                  (prefix "sx-home-stepper="))
                (let
                  ((val (when (and (string? raw) (contains? raw prefix)) (let ((start (+ (index-of raw prefix) (len prefix)))) (let ((rest (slice raw start)) (end-pos (index-of (slice raw start) ";"))) (if (> end-pos -1) (slice rest 0 end-pos) rest))))))
                  (let ((n (if val (parse-number val) 0))) {:step-idx (signal (if (and (number? n) (>= n 0) (<= n 16)) n 0))})))))
          nil))
      (step-idx
        (if
          store
          (get store "step-idx")
          (let
            ((cv (get-cookie "sx-home-stepper")))
            (let
              ((n (if cv (parse-number cv) 0)))
              (signal (if (and (number? n) (>= n 0) (<= n 16)) n 0))))))
      (dom-stack-sig (signal (list)))
      (code-tokens (signal (list))))
    (letrec
      ((split-tag (fn (expr result) (cond (not (list? expr)) (append! result {:expr expr :type "leaf"}) (empty? expr) nil (not (= (type-of (first expr)) "symbol")) (append! result {:expr expr :type "leaf"}) (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 {:spreads spreads :tag ctag :type "open" :attrs cat}) (for-each (fn (c) (split-tag c result)) cch) (append! result {:open-attrs cat :open-spreads spreads :tag ctag :type "close"})) :else (append! result {:expr expr :type "expr"}))))
        (build-code-tokens
          (fn
            (expr tokens step-ref indent)
            (cond
              (string? expr)
              (do
                (append! tokens {:cls "text-emerald-700" :step (get step-ref "v") :text (str "\"" expr "\"")})
                (dict-set! step-ref "v" (+ (get step-ref "v") 1)))
              (number? expr)
              (do
                (append! tokens {:cls "text-amber-700" :step (get step-ref "v") :text (str expr)})
                (dict-set! step-ref "v" (+ (get step-ref "v") 1)))
              (= (type-of expr) "keyword")
              (append! tokens {:cls "text-violet-600" :step (get step-ref "v") :text (str ":" (keyword-name expr))})
              (= (type-of expr) "symbol")
              (let ((name (symbol-name expr))) (append! tokens {: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") :text name}))
              (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 {:cls "text-stone-400" :step open-step :text "("})
                  (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
                          (let
                            ((saved (get step-ref "v"))
                              (saved-tokens-len (len tokens)))
                            (append! tokens {:cls "" :step -1 :text " "})
                            (build-code-tokens a tokens step-ref indent)
                            (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 {:cls "" :step -1 :text (str "\n" (join "" (map (fn (_) "  ") (range 0 (+ indent 1)))))})
                              (build-code-tokens
                                a
                                tokens
                                step-ref
                                (+ indent 1)))
                            (do
                              (append! tokens {:cls "" :step -1 :text " "})
                              (build-code-tokens a tokens step-ref indent))))))
                    (rest expr))
                  (append! tokens {:cls "text-stone-400" :step open-step :text ")"})
                  (when
                    is-tag
                    (dict-set! step-ref "v" (+ (get step-ref "v") 1)))))
              :else nil)))
        (steps-to-preview
          (fn
            (all-steps target)
            (if
              (or (empty? all-steps) (<= target 0))
              nil
              (let
                ((pos (dict "i" 0)) (max-i (min target (len all-steps))))
                (letrec
                  ((bc-loop (fn (children) (if (>= (get pos "i") max-i) children (let ((step (nth all-steps (get pos "i"))) (stype (get step "type"))) (cond (= stype "open") (do (dict-set! pos "i" (+ (get pos "i") 1)) (let ((tag (get step "tag")) (attrs (or (get step "attrs") (list))) (spreads (or (get step "spreads") (list))) (inner (bc-loop (list)))) (append! children (concat (list (make-symbol tag)) spreads attrs inner))) (bc-loop children)) (= stype "close") (do (dict-set! pos "i" (+ (get pos "i") 1)) children) (= stype "leaf") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) (= stype "expr") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) :else (do (dict-set! pos "i" (+ (get pos "i") 1)) (bc-loop children))))))))
                  (let
                    ((root (bc-loop (list))))
                    (cond
                      (= (len root) 1)
                      (first root)
                      (empty? root)
                      nil
                      :else (concat (list (make-symbol "<>")) root))))))))
        (get-preview (fn () (dom-query "[data-sx-lake=\"home-preview\"]")))
        (get-code-view (fn () (dom-query "[data-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 () nil))
        (update-code-highlight
          (fn
            ()
            (let
              ((code-el (get-code-view))
                (cur (deref step-idx))
                (tokens (deref code-tokens)))
              (when
                (and code-el (not (empty? tokens)))
                (dom-set-prop
                  code-el
                  "innerHTML"
                  (join
                    ""
                    (map
                      (fn
                        (tok)
                        (let
                          ((step-num (get tok "step"))
                            (base (get tok "cls"))
                            (text (replace (get tok "text") "&" "&amp;")))
                          (str
                            "<span class=\""
                            base
                            (cond
                              (= step-num -1)
                              ""
                              (= step-num cur)
                              " bg-amber-100 rounded px-0.5 font-bold text-sm"
                              (< step-num cur)
                              " font-bold text-xs"
                              :else " opacity-40")
                            "\">"
                            text
                            "</span>")))
                      tokens)))))))
        (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)
                        (when
                          (and
                            (list? sp)
                            (>= (len sp) 3)
                            (= (type-of (nth sp 1)) "keyword")
                            (= (keyword-name (nth sp 1)) "tokens")
                            (string? (nth sp 2)))
                          (let
                            ((result (trampoline (~tw :tokens (nth sp 2)))))
                            (when
                              (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")
                  nil))
              (swap! step-idx inc)
              (update-code-highlight)
              (host-set!
                (dom-document)
                "cookie"
                (str
                  "sx-home-stepper="
                  (deref step-idx)
                  ";path=/;max-age=31536000;SameSite=Lax")))))
        (rebuild-preview
          (fn
            (target)
            (let
              ((container (get-preview)))
              (when
                container
                (dom-set-prop container "innerHTML" "")
                (let
                  ((expr (steps-to-preview (deref steps) target)))
                  (when
                    expr
                    (let
                      ((dom (render-to-dom expr (get-render-env nil) nil)))
                      (when dom (dom-append container dom)))))
                (let
                  ((depth 0) (all (deref steps)))
                  (let
                    loop
                    ((i 0))
                    (when
                      (< i target)
                      (let
                        ((stype (get (nth all i) "type")))
                        (cond
                          (= stype "open")
                          (set! depth (+ depth 1))
                          (= stype "close")
                          (set! depth (- depth 1))))
                      (loop (+ i 1))))
                  (let
                    ((stack (list container)) (node container))
                    (let
                      walk
                      ((d 0))
                      (when
                        (< d depth)
                        (let
                          ((child (host-get node "lastElementChild")))
                          (when
                            child
                            (append! stack child)
                            (set! node child)))
                        (walk (+ d 1))))
                    (set-stack stack)))))))
        (do-back
          (fn
            ()
            (when
              (> (deref step-idx) 0)
              (let
                ((target (- (deref step-idx) 1)))
                (rebuild-preview target)
                (reset! step-idx target)
                (update-code-highlight)
                (host-set!
                  (dom-document)
                  "cookie"
                  (str
                    "sx-home-stepper="
                    target
                    ";path=/;max-age=31536000;SameSite=Lax")))))))
      nil
      (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)))))
      (let
        ((_eff (let ((first-run (signal true))) (effect (fn () (let ((cur (deref step-idx))) (if (deref first-run) (do (reset! first-run false) (host-call (host-global "queueMicrotask") (host-callback (fn () (update-code-highlight) (rebuild-preview cur) (run-post-render-hooks))))) (schedule-idle (fn () (build-code-dom) (rebuild-preview cur) (update-code-highlight) (run-post-render-hooks))))))))))
        (div
          (~tw :tokens "space-y-4 text-center")
          (div
            :data-code-view true
            (~tw
              :tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
            :style "font-size:0.85rem"
            (when
              (not (client?))
              (map
                (fn
                  (tok)
                  (let
                    ((step (get tok "step"))
                      (cur (deref step-idx))
                      (is-spread (get tok "spread"))
                      (cls
                        (str
                          (get tok "cls")
                          (cond
                            (= step -1)
                            ""
                            (= step cur)
                            " bg-amber-100 rounded px-0.5 font-bold text-sm"
                            (< step cur)
                            " font-bold text-xs"
                            :else " opacity-40"))))
                    (span :class cls (get tok "text"))))
                (deref code-tokens))))
          (div
            (~tw :tokens "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"))
              "◀")
            (span
              (~tw :tokens "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"))
              "▶"))
          (lake
            :id "home-preview"
            (when
              (not (client?))
              (steps-to-preview (deref steps) (deref step-idx)))))))))
