rose-ash/web/adapter-html.sx

;; ==========================================================================
;; adapter-html.sx — HTML string rendering adapter
;;
;; Renders evaluated SX expressions to HTML strings. Used server-side.
;;
;; Depends on:
;;   render.sx  — HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS,
;;                parse-element-args, render-attrs, definition-form?
;;   eval.sx    — eval-expr, trampoline, expand-macro, process-bindings,
;;                eval-cond, env-has?, env-get, env-set!, env-merge,
;;                lambda?, component?, island?, macro?,
;;                lambda-closure, lambda-params, lambda-body
;; ==========================================================================


(define render-to-html :effects [render]
  (fn (expr (env :as dict))
    (set-render-active! true)
    (case (type-of expr)
      ;; Literals — render directly
      "nil"     ""
      "string"  (escape-html expr)
      "number"  (str expr)
      "boolean" (if expr "true" "false")
      ;; List — dispatch to render-list which handles HTML tags, special forms, etc.
      "list"    (if (empty? expr) "" (render-list-to-html expr env))
      ;; Symbol — evaluate then render
      "symbol"  (render-value-to-html (trampoline (eval-expr expr env)) env)
      ;; Keyword — render as text
      "keyword" (escape-html (keyword-name expr))
      ;; Raw HTML passthrough
      "raw-html" (raw-html-content expr)
      ;; Spread — emit attrs to nearest element provider
      "spread"  (do (emit! "element-attrs" (spread-attrs expr)) "")
      ;; Thunk — unwrap and render the inner expression (from letrec TCO)
      "thunk"   (render-to-html (thunk-expr expr) (thunk-env expr))
      ;; Everything else — evaluate first
      :else     (render-value-to-html (trampoline (eval-expr expr env)) env))))

(define render-value-to-html :effects [render]
  (fn (val (env :as dict))
    (case (type-of val)
      "nil"     ""
      "string"  (escape-html val)
      "number"  (str val)
      "boolean" (if val "true" "false")
      "list"    (render-list-to-html val env)
      "raw-html" (raw-html-content val)
      "spread"  (do (emit! "element-attrs" (spread-attrs val)) "")
      "thunk"   (render-to-html (thunk-expr val) (thunk-env val))
      :else     (escape-html (str val)))))


;; --------------------------------------------------------------------------
;; Render-aware form classification
;; --------------------------------------------------------------------------

(define RENDER_HTML_FORMS
  (list "if" "when" "cond" "case" "let" "let*" "begin" "do"
        "define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
        "deftype" "defeffect"
        "map" "map-indexed" "filter" "for-each" "scope" "provide"))

(define render-html-form? :effects []
  (fn ((name :as string))
    (contains? RENDER_HTML_FORMS name)))


;; --------------------------------------------------------------------------
;; render-list-to-html — dispatch on list head
;; --------------------------------------------------------------------------

(define render-list-to-html :effects [render]
  (fn ((expr :as list) (env :as dict))
    (if (empty? expr)
      ""
      (let ((head (first expr)))
        (if (not (= (type-of head) "symbol"))
          ;; Data list — render each item
          (join "" (map (fn (x) (render-value-to-html x env)) expr))
          (let ((name (symbol-name head))
                (args (rest expr)))
            (cond
              ;; Fragment
              (= name "<>")
                (join "" (map (fn (x) (render-to-html x env)) args))

              ;; Raw HTML passthrough
              (= name "raw!")
                (join "" (map (fn (x) (str (trampoline (eval-expr x env)))) args))

              ;; Lake — server-morphable slot within an island
              (= name "lake")
                (render-html-lake args env)

              ;; Marsh — reactive server-morphable slot within an island
              (= name "marsh")
                (render-html-marsh args env)

              ;; HTML tag
              (contains? HTML_TAGS name)
                (render-html-element name args env)

              ;; Island (~name) — reactive component, SSR with hydration markers
              (and (starts-with? name "~")
                   (env-has? env name)
                   (island? (env-get env name)))
                (render-html-island (env-get env name) args env)

              ;; Component or macro call (~name)
              (starts-with? name "~")
                (let ((val (env-get env name)))
                  (cond
                    (component? val)
                      (render-html-component val args env)
                    (macro? val)
                      (render-to-html
                        (expand-macro val args env)
                        env)
                    :else
                      (error (str "Unknown component: " name))))

              ;; Render-aware special forms
              (render-html-form? name)
                (dispatch-html-form name expr env)

              ;; Macro expansion
              (and (env-has? env name) (macro? (env-get env name)))
                (render-to-html
                  (expand-macro (env-get env name) args env)
                  env)

              ;; Fallback — evaluate then render result
              :else
                (render-value-to-html
                  (trampoline (eval-expr expr env))
                  env))))))))


;; --------------------------------------------------------------------------
;; dispatch-html-form — render-aware special form handling for HTML output
;; --------------------------------------------------------------------------

(define dispatch-html-form :effects [render]
  (fn ((name :as string) (expr :as list) (env :as dict))
    (cond
      ;; if
      (= name "if")
        (let ((cond-val (trampoline (eval-expr (nth expr 1) env))))
          (if cond-val
            (render-to-html (nth expr 2) env)
            (if (> (len expr) 3)
              (render-to-html (nth expr 3) env)
              "")))

      ;; when — single body: pass through. Multi: join strings.
      (= name "when")
        (if (not (trampoline (eval-expr (nth expr 1) env)))
          ""
          (if (= (len expr) 3)
            (render-to-html (nth expr 2) env)
            (join "" (map (fn (i) (render-to-html (nth expr i) env))
                          (range 2 (len expr))))))

      ;; cond
      (= name "cond")
        (let ((branch (eval-cond (rest expr) env)))
          (if branch
            (render-to-html branch env)
            ""))

      ;; case
      (= name "case")
        (render-to-html (trampoline (eval-expr expr env)) env)

      ;; let / let* — single body: pass through. Multi: join strings.
      (or (= name "let") (= name "let*"))
        (let ((local (process-bindings (nth expr 1) env)))
          (if (= (len expr) 3)
            (render-to-html (nth expr 2) local)
            (join "" (map (fn (i) (render-to-html (nth expr i) local))
                          (range 2 (len expr))))))

      ;; begin / do — single body: pass through. Multi: join strings.
      (or (= name "begin") (= name "do"))
        (if (= (len expr) 2)
          (render-to-html (nth expr 1) env)
          (join "" (map (fn (i) (render-to-html (nth expr i) env))
                        (range 1 (len expr)))))

      ;; Definition forms — eval for side effects
      (definition-form? name)
        (do (trampoline (eval-expr expr env)) "")

      ;; map
      (= name "map")
        (let ((f (trampoline (eval-expr (nth expr 1) env)))
              (coll (trampoline (eval-expr (nth expr 2) env))))
          (join ""
            (map
              (fn (item)
                (if (lambda? f)
                  (render-lambda-html f (list item) env)
                  (render-to-html (apply f (list item)) env)))
              coll)))

      ;; map-indexed
      (= name "map-indexed")
        (let ((f (trampoline (eval-expr (nth expr 1) env)))
              (coll (trampoline (eval-expr (nth expr 2) env))))
          (join ""
            (map-indexed
              (fn (i item)
                (if (lambda? f)
                  (render-lambda-html f (list i item) env)
                  (render-to-html (apply f (list i item)) env)))
              coll)))

      ;; filter — evaluate fully then render
      (= name "filter")
        (render-to-html (trampoline (eval-expr expr env)) env)

      ;; for-each (render variant)
      (= name "for-each")
        (let ((f (trampoline (eval-expr (nth expr 1) env)))
              (coll (trampoline (eval-expr (nth expr 2) env))))
          (join ""
            (map
              (fn (item)
                (if (lambda? f)
                  (render-lambda-html f (list item) env)
                  (render-to-html (apply f (list item)) env)))
              coll)))

      ;; scope — unified render-time dynamic scope
      (= name "scope")
        (let ((scope-name (trampoline (eval-expr (nth expr 1) env)))
              (rest-args (slice expr 2))
              (scope-val nil)
              (body-exprs nil))
          ;; Check for :value keyword
          (if (and (>= (len rest-args) 2)
                   (= (type-of (first rest-args)) "keyword")
                   (= (keyword-name (first rest-args)) "value"))
            (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env)))
                (set! body-exprs (slice rest-args 2)))
            (set! body-exprs rest-args))
          (scope-push! scope-name scope-val)
          (let ((result (if (= (len body-exprs) 1)
                          (render-to-html (first body-exprs) env)
                          (join "" (map (fn (e) (render-to-html e env)) body-exprs)))))
            (scope-pop! scope-name)
            result))

      ;; provide — sugar for scope with value
      (= name "provide")
        (let ((prov-name (trampoline (eval-expr (nth expr 1) env)))
              (prov-val (trampoline (eval-expr (nth expr 2) env)))
              (body-start 3)
              (body-count (- (len expr) 3)))
          (scope-push! prov-name prov-val)
          (let ((result (if (= body-count 1)
                          (render-to-html (nth expr body-start) env)
                          (join "" (map (fn (i) (render-to-html (nth expr i) env))
                                       (range body-start (+ body-start body-count)))))))
            (scope-pop! prov-name)
            result))

      ;; Fallback
      :else
        (render-value-to-html (trampoline (eval-expr expr env)) env))))


;; --------------------------------------------------------------------------
;; render-lambda-html — render a lambda body in HTML context
;; --------------------------------------------------------------------------

(define render-lambda-html :effects [render]
  (fn ((f :as lambda) (args :as list) (env :as dict))
    (let ((local (env-merge (lambda-closure f) env)))
      (for-each-indexed
        (fn (i p)
          (env-bind! local p (nth args i)))
        (lambda-params f))
      (render-to-html (lambda-body f) local))))


;; --------------------------------------------------------------------------
;; render-html-component — expand and render a component
;; --------------------------------------------------------------------------

(define render-html-component :effects [render]
  (fn ((comp :as component) (args :as list) (env :as dict))
    ;; Expand component and render body through HTML adapter.
    ;; Component body contains rendering forms (HTML tags) that only the
    ;; adapter understands, so expansion must happen here, not in eval-expr.
    (let ((kwargs (dict))
          (children (list)))
      ;; Separate keyword args from positional children
      (reduce
        (fn (state arg)
          (let ((skip (get state "skip")))
            (if skip
              (assoc state "skip" false "i" (inc (get state "i")))
              (if (and (= (type-of arg) "keyword")
                       (< (inc (get state "i")) (len args)))
                (let ((val (trampoline
                             (eval-expr (nth args (inc (get state "i"))) env))))
                  (dict-set! kwargs (keyword-name arg) val)
                  (assoc state "skip" true "i" (inc (get state "i"))))
                (do
                  (append! children arg)
                  (assoc state "i" (inc (get state "i"))))))))
        (dict "i" 0 "skip" false)
        args)
      ;; Build component env: closure + caller env + params
      (let ((local (env-merge (component-closure comp) env)))
        ;; Bind params from kwargs
        (for-each
          (fn (p)
            (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
          (component-params comp))
        ;; If component accepts children, pre-render them to raw HTML
        (when (component-has-children? comp)
          (env-bind! local "children"
            (make-raw-html (join "" (map (fn (c) (render-to-html c env)) children)))))
        (render-to-html (component-body comp) local)))))


(define render-html-element :effects [render]
  (fn ((tag :as string) (args :as list) (env :as dict))
    (let ((parsed (parse-element-args args env))
          (attrs  (first parsed))
          (children (nth parsed 1))
          (is-void (contains? VOID_ELEMENTS tag)))
      (if is-void
        (str "<" tag (render-attrs attrs) " />")
        ;; Provide scope for spread emit!
        (do
          (scope-push! "element-attrs" nil)
          (let ((content (join "" (map (fn (c) (render-to-html c env)) children))))
            (for-each
              (fn (spread-dict) (merge-spread-attrs attrs spread-dict))
              (emitted "element-attrs"))
            (scope-pop! "element-attrs")
            (str "<" tag (render-attrs attrs) ">"
              content
              "</" tag ">")))))))


;; --------------------------------------------------------------------------
;; render-html-lake — SSR rendering of a server-morphable slot
;; --------------------------------------------------------------------------
;;
;; (lake :id "name" children...) → <div data-sx-lake="name">children</div>
;;
;; Lakes are server territory inside islands. The morph can update lake
;; content while preserving surrounding reactive DOM.

(define render-html-lake :effects [render]
  (fn ((args :as list) (env :as dict))
    (let ((lake-id nil)
          (lake-tag "div")
          (children (list)))
      (reduce
        (fn (state arg)
          (let ((skip (get state "skip")))
            (if skip
              (assoc state "skip" false "i" (inc (get state "i")))
              (if (and (= (type-of arg) "keyword")
                       (< (inc (get state "i")) (len args)))
                (let ((kname (keyword-name arg))
                      (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
                  (cond
                    (= kname "id")  (set! lake-id kval)
                    (= kname "tag") (set! lake-tag kval))
                  (assoc state "skip" true "i" (inc (get state "i"))))
                (do
                  (append! children arg)
                  (assoc state "i" (inc (get state "i"))))))))
        (dict "i" 0 "skip" false)
        args)
      ;; Provide scope for spread emit!
      (let ((lake-attrs (dict "data-sx-lake" (or lake-id ""))))
        (scope-push! "element-attrs" nil)
        (let ((content (join "" (map (fn (c) (render-to-html c env)) children))))
          (for-each
            (fn (spread-dict) (merge-spread-attrs lake-attrs spread-dict))
            (emitted "element-attrs"))
          (scope-pop! "element-attrs")
          (str "<" lake-tag (render-attrs lake-attrs) ">"
               content
               "</" lake-tag ">"))))))


;; --------------------------------------------------------------------------
;; render-html-marsh — SSR rendering of a reactive server-morphable slot
;; --------------------------------------------------------------------------
;;
;; (marsh :id "name" :tag "div" :transform fn children...)
;; → <div data-sx-marsh="name">children</div>
;;
;; Like a lake but reactive: during morph, new content is parsed as SX and
;; re-evaluated in the island's signal scope. Server renders children normally;
;; the :transform is a client-only concern.

(define render-html-marsh :effects [render]
  (fn ((args :as list) (env :as dict))
    (let ((marsh-id nil)
          (marsh-tag "div")
          (children (list)))
      (reduce
        (fn (state arg)
          (let ((skip (get state "skip")))
            (if skip
              (assoc state "skip" false "i" (inc (get state "i")))
              (if (and (= (type-of arg) "keyword")
                       (< (inc (get state "i")) (len args)))
                (let ((kname (keyword-name arg))
                      (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
                  (cond
                    (= kname "id")        (set! marsh-id kval)
                    (= kname "tag")       (set! marsh-tag kval)
                    (= kname "transform") nil)
                  (assoc state "skip" true "i" (inc (get state "i"))))
                (do
                  (append! children arg)
                  (assoc state "i" (inc (get state "i"))))))))
        (dict "i" 0 "skip" false)
        args)
      ;; Provide scope for spread emit!
      (let ((marsh-attrs (dict "data-sx-marsh" (or marsh-id ""))))
        (scope-push! "element-attrs" nil)
        (let ((content (join "" (map (fn (c) (render-to-html c env)) children))))
          (for-each
            (fn (spread-dict) (merge-spread-attrs marsh-attrs spread-dict))
            (emitted "element-attrs"))
          (scope-pop! "element-attrs")
          (str "<" marsh-tag (render-attrs marsh-attrs) ">"
               content
               "</" marsh-tag ">"))))))


;; --------------------------------------------------------------------------
;; render-html-island — SSR rendering of a reactive island
;; --------------------------------------------------------------------------
;;
;; Renders the island body as static HTML wrapped in a container element
;; with data-sx-island and data-sx-state attributes. The client hydrates
;; this by finding these elements and re-rendering with reactive context.
;;
;; On the server, signal/deref/reset!/swap! are simple passthrough:
;;   (signal val) → returns val (no container needed server-side)
;;   (deref s)    → returns s (signal values are plain values server-side)
;;   (reset! s v) → no-op
;;   (swap! s f)  → no-op

(define render-html-island :effects [render]
  (fn ((island :as island) (args :as list) (env :as dict))
    ;; Parse kwargs and children (same pattern as render-html-component)
    (let ((kwargs (dict))
          (children (list)))
      (reduce
        (fn (state arg)
          (let ((skip (get state "skip")))
            (if skip
              (assoc state "skip" false "i" (inc (get state "i")))
              (if (and (= (type-of arg) "keyword")
                       (< (inc (get state "i")) (len args)))
                (let ((val (trampoline
                             (eval-expr (nth args (inc (get state "i"))) env))))
                  (dict-set! kwargs (keyword-name arg) val)
                  (assoc state "skip" true "i" (inc (get state "i"))))
                (do
                  (append! children arg)
                  (assoc state "i" (inc (get state "i"))))))))
        (dict "i" 0 "skip" false)
        args)

      ;; Build island env: closure + caller env + params
      (let ((local (env-merge (component-closure island) env))
            (island-name (component-name island)))

        ;; Bind params from kwargs
        (for-each
          (fn (p)
            (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
          (component-params island))

        ;; If island accepts children, pre-render them to raw HTML
        (when (component-has-children? island)
          (env-bind! local "children"
            (make-raw-html (join "" (map (fn (c) (render-to-html c env)) children)))))

        ;; Render the island body as HTML
        (let ((body-html (render-to-html (component-body island) local))
              (state-sx (serialize-island-state kwargs)))
          ;; Wrap in container with hydration attributes
          (str "<span data-sx-island=\"" (escape-attr island-name) "\""
               (if state-sx
                 (str " data-sx-state=\"" (escape-attr state-sx) "\"")
                 "")
               ">"
               body-html
               "</span>"))))))


;; --------------------------------------------------------------------------
;; serialize-island-state — serialize kwargs to SX for hydration
;; --------------------------------------------------------------------------
;;
;; Uses the SX serializer (not JSON) so the client can parse with sx-parse.
;; Handles all SX types natively: numbers, strings, booleans, nil, lists, dicts.

(define serialize-island-state :effects []
  (fn ((kwargs :as dict))
    (if (empty-dict? kwargs)
      nil
      (sx-serialize kwargs))))


;; --------------------------------------------------------------------------
;; Platform interface — HTML adapter
;; --------------------------------------------------------------------------
;;
;; Inherited from render.sx:
;;   escape-html, escape-attr, raw-html-content
;;
;; From eval.sx:
;;   eval-expr, trampoline, expand-macro, process-bindings, eval-cond
;;   env-has?, env-get, env-set!, env-merge
;;   lambda?, component?, island?, macro?
;;   lambda-closure, lambda-params, lambda-body
;;   component-params, component-body, component-closure,
;;   component-has-children?, component-name
;;
;; Raw HTML construction:
;;   (make-raw-html s)          → wrap string as raw HTML (not double-escaped)
;;
;; Island state serialization:
;;   (sx-serialize val)         → SX source string (from parser.sx)
;;   (empty-dict? d)            → boolean
;;   (escape-attr s)            → HTML attribute escape
;;
;; Iteration:
;;   (for-each-indexed fn coll) → call fn(index, item) for each element
;;   (map-indexed fn coll)      → map fn(index, item) over each element
;; --------------------------------------------------------------------------