;; ==========================================================================
;; adapter-sx.sx — SX wire format rendering adapter
;;
;; Serializes SX expressions for client-side rendering.
;; Component calls are NOT expanded — they're sent to the client as-is.
;; HTML tags are serialized as SX source text. Special forms are evaluated.
;;
;; Depends on:
;;   render.sx  — HTML_TAGS
;;   eval.sx    — eval-expr, trampoline, call-lambda, expand-macro
;; ==========================================================================


(define render-to-sx :effects [render]
  (fn (expr (env :as dict))
    (let ((result (aser expr env)))
      ;; aser-call returns SxExpr which serialize passes through unquoted.
      ;; Plain strings from data need serialization (quoting).
      (cond
        (= (type-of result) "sx-expr") (sx-expr-source result)
        (= (type-of result) "string")  result
        :else (serialize result)))))

(define aser :effects [render]
  (fn ((expr :as any) (env :as dict))
    ;; Evaluate for SX wire format — serialize rendering forms,
    ;; evaluate control flow and function calls.
    (set-render-active! true)
    (let ((result
      (case (type-of expr)
        "number"  expr
        "string"  expr
        "boolean" expr
        "nil"     nil

        "symbol"
          (let ((name (symbol-name expr)))
            (cond
              (env-has? env name)     (env-get env name)
              (primitive? name)       (get-primitive name)
              (= name "true")        true
              (= name "false")       false
              (= name "nil")         nil
              :else (error (str "Undefined symbol: " name))))

        "keyword" (keyword-name expr)

        "list"
          (if (empty? expr)
            (list)
            (aser-list expr env))

        ;; Spread — emit attrs to nearest element provider
        "spread"  (do (scope-emit! "element-attrs" (spread-attrs expr)) nil)

        :else expr)))
      ;; Catch spread values from function calls and symbol lookups
      (if (spread? result)
        (do (scope-emit! "element-attrs" (spread-attrs result)) nil)
        result))))


(define aser-list :effects [render]
  (fn ((expr :as list) (env :as dict))
    (let ((head (first expr))
          (args (rest expr)))
      (if (not (= (type-of head) "symbol"))
        (map (fn (x) (aser x env)) expr)
        (let ((name (symbol-name head)))
          (cond
            ;; Fragment — serialize children
            (= name "<>")
              (aser-fragment args env)

            ;; raw! — pass through as serialized call
            (= name "raw!")
              (aser-call "raw!" args env)

            ;; Component call — expand if server-affinity or expand-components? is set.
            ;; expand-components? is a platform primitive (like eval-expr, trampoline);
            ;; adapter-async.sx uses the same pattern at line 684.
            ;; Guard with env-has? for backward compat with older kernels.
            (starts-with? name "~")
              (let ((comp (if (env-has? env name) (env-get env name) nil))
                    (expand-all (if (env-has? env "expand-components?")
                                  (expand-components?) false)))
                (cond
                  (and comp (macro? comp))
                    (aser (expand-macro comp args env) env)
                  (and comp (component? comp)
                       (not (island? comp))
                       (or expand-all
                           (= (component-affinity comp) "server"))
                       ;; :affinity :client components are never expanded
                       ;; server-side — they depend on browser-only state.
                       (not (= (component-affinity comp) "client")))
                    (aser-expand-component comp args env)
                  :else
                    (aser-call name args env)))

            ;; Lake — serialize (server-morphable slot)
            (= name "lake")
              (aser-call name args env)

            ;; Marsh — serialize (reactive server-morphable slot)
            (= name "marsh")
              (aser-call name args env)

            ;; HTML tag — serialize
            (contains? HTML_TAGS name)
              (aser-call name args env)

            ;; Special/HO forms — evaluate (produces data)
            (or (special-form? name) (ho-form? name))
              (aser-special name expr env)

            ;; Macro — expand then aser
            (and (env-has? env name) (macro? (env-get env name)))
              (aser (expand-macro (env-get env name) args env) env)

            ;; Function call — evaluate fully
            :else
              (let ((f (trampoline (eval-expr head env)))
                    (evaled-args (map (fn (a) (trampoline (eval-expr a env))) args)))
                (cond
                  (and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
                    (apply f evaled-args)
                  (lambda? f)
                    (trampoline (call-lambda f evaled-args env))
                  (component? f)
                    (aser-call (str "~" (component-name f)) args env)
                  (island? f)
                    (aser-call (str "~" (component-name f)) args env)
                  :else (error (str "Not callable: " (inspect f)))))))))))


;; Re-serialize an evaluated HTML element list, restoring keyword syntax.
;; The CEK evaluates keywords to strings, so (tr :class "row") becomes
;; (list Symbol("tr") String("class") String("row")). This function
;; detects string pairs where the first string is an HTML attribute name
;; and restores them as :keyword syntax for the SX wire format.
(define aser-reserialize :effects []
  (fn (val)
    (if (not (= (type-of val) "list"))
      (serialize val)
      (if (empty? val)
        "()"
        (let ((head (first val)))
          (if (not (= (type-of head) "symbol"))
            (serialize val)
            (let ((tag (symbol-name head))
                  (parts (list tag))
                  (args (rest val))
                  (skip false)
                  (i 0))
              (for-each
                (fn (arg)
                  (if skip
                    (do (set! skip false) (set! i (inc i)))
                    (if (and (= (type-of arg) "string")
                             (< (inc i) (len args))
                             ;; Heuristic: if the next arg is also a string or a list,
                             ;; and this arg looks like an attribute name (no spaces,
                             ;; starts with lowercase or is a known attr pattern)
                             (not (contains? arg " "))
                             (or (starts-with? arg "class")
                                 (starts-with? arg "id")
                                 (starts-with? arg "sx-")
                                 (starts-with? arg "data-")
                                 (starts-with? arg "style")
                                 (starts-with? arg "href")
                                 (starts-with? arg "src")
                                 (starts-with? arg "type")
                                 (starts-with? arg "name")
                                 (starts-with? arg "value")
                                 (starts-with? arg "placeholder")
                                 (starts-with? arg "action")
                                 (starts-with? arg "method")
                                 (starts-with? arg "target")
                                 (starts-with? arg "role")
                                 (starts-with? arg "for")
                                 (starts-with? arg "on")))
                      (do
                        (append! parts (str ":" arg))
                        (append! parts (serialize (nth args (inc i))))
                        (set! skip true)
                        (set! i (inc i)))
                      (do
                        (append! parts (aser-reserialize arg))
                        (set! i (inc i))))))
                args)
              (str "(" (join " " parts) ")"))))))))


(define aser-fragment :effects [render]
  (fn ((children :as list) (env :as dict))
    ;; Serialize (<> child1 child2 ...) to sx source string
    ;; Must flatten list results (e.g. from map/filter) to avoid nested parens
    (let ((parts (list)))
      (for-each
        (fn (c)
          (let ((result (aser c env)))
            (cond
              (nil? result) nil
              (= (type-of result) "sx-expr")
                (append! parts (sx-expr-source result))
              ;; list results (from map etc.)
              (= (type-of result) "list")
                (for-each
                  (fn (item)
                    (when (not (nil? item))
                      (if (= (type-of item) "sx-expr")
                        (append! parts (sx-expr-source item))
                        (append! parts (aser-reserialize item)))))
                  result)
              ;; Everything else — serialize normally (quotes strings)
              :else
                (append! parts (serialize result)))))
        children)
      (if (empty? parts)
        ""
        (if (= (len parts) 1)
          (make-sx-expr (first parts))
          (make-sx-expr (str "(<> " (join " " parts) ")")))))))


(define aser-call :effects [render]
  (fn ((name :as string) (args :as list) (env :as dict))
    ;; Serialize (name :key val child ...) — evaluate args but keep as sx
    ;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops
    ;; that can contain nested for-each for list flattening.
    ;; Separate attrs and children so emitted spread attrs go before children.
    (let ((attr-parts (list))
          (child-parts (list))
          (skip false)
          (i 0))
      ;; Provide scope for spread emit!
      (scope-push! "element-attrs" nil)
      (for-each
        (fn (arg)
          (if skip
            (do (set! skip false)
                (set! i (inc i)))
            (if (and (= (type-of arg) "keyword")
                     (< (inc i) (len args)))
              (let ((val (aser (nth args (inc i)) env)))
                (when (not (nil? val))
                  (append! attr-parts (str ":" (keyword-name arg)))
                  (if (= (type-of val) "sx-expr")
                    (append! attr-parts (sx-expr-source val))
                    (append! attr-parts (serialize val))))
                (set! skip true)
                (set! i (inc i)))
              (let ((val (aser arg env)))
                (when (not (nil? val))
                  (cond
                    (= (type-of val) "sx-expr")
                      (append! child-parts (sx-expr-source val))
                    ;; List results (from map etc.)
                    (= (type-of val) "list")
                      (for-each
                        (fn (item)
                          (when (not (nil? item))
                            (if (= (type-of item) "sx-expr")
                              (append! child-parts (sx-expr-source item))
                              (append! child-parts (serialize item)))))
                        val)
                    ;; Plain values — serialize normally
                    :else
                      (append! child-parts (serialize val))))
                (set! i (inc i))))))
        args)
      ;; Collect emitted spread attrs — goes after explicit attrs, before children
      (for-each
        (fn (spread-dict)
          (for-each
            (fn (k)
              (let ((v (dict-get spread-dict k)))
                (append! attr-parts (str ":" k))
                (append! attr-parts (serialize v))))
            (keys spread-dict)))
        (scope-peek "element-attrs"))
      (scope-pop! "element-attrs")
      (let ((parts (concat (list name) attr-parts child-parts)))
        (make-sx-expr (str "(" (join " " parts) ")"))))))


;; --------------------------------------------------------------------------
;; Server-affinity component expansion
;; --------------------------------------------------------------------------
;;
;; When a component has :affinity :server, the aser expands it inline:
;; bind keyword args + children, then aser the body.
;; This is the aser equivalent of render-to-html's component expansion.

(define aser-expand-component :effects [render]
  (fn ((comp :as any) (args :as list) (env :as dict))
    (let ((params (component-params comp))
          (local (env-merge env (component-closure comp)))
          (i 0)
          (skip false)
          (children (list)))
      ;; Default all keyword params to nil (same as the CEK evaluator)
      (for-each (fn (p) (env-bind! local p nil)) params)
      ;; Parse keyword args and positional children from args.
      ;; Keyword values are ASERED (not eval'd) — they may contain
      ;; rendering constructs (<>, HTML tags) that eval-expr can't
      ;; handle. The aser result is a string/value that the body's
      ;; aser will inline correctly (strings starting with "(" are
      ;; recognized as serialized SX by aserCall).
      (for-each
        (fn (arg)
          (if skip
            (do (set! skip false) (set! i (inc i)))
            (if (and (= (type-of arg) "keyword")
                     (< (inc i) (len args)))
              ;; Keyword arg: bind name = aser'd next arg
              ;; SxExpr values pass through serialize unquoted automatically
              (do
                (env-bind! local (keyword-name arg)
                  (aser (nth args (inc i)) env))
                (set! skip true)
                (set! i (inc i)))
              ;; Positional child: keep as unevaluated AST for aser
              (do
                (append! children arg)
                (set! i (inc i))))))
        args)
      ;; Bind &rest children — aser each child first, then bind the result
      (when (component-has-children comp)
        (let ((asered-children
                (map (fn (c) (aser c env)) children)))
          (env-bind! local "children"
            (if (= (len asered-children) 1)
              (first asered-children)
              asered-children))))
      ;; Aser the body in the merged env
      (aser (component-body comp) local))))


;; --------------------------------------------------------------------------
;; Form classification
;; --------------------------------------------------------------------------

(define SPECIAL_FORM_NAMES
  (list "if" "when" "cond" "case" "and" "or"
        "let" "let*" "lambda" "fn"
        "define" "defcomp" "defmacro" "defstyle"
        "defhandler" "defpage" "defquery" "defaction" "defrelation"
        "begin" "do" "quote" "quasiquote"
        "->" "set!" "letrec" "dynamic-wind" "defisland"
        "deftype" "defeffect" "scope" "provide"
        "context" "emit!" "emitted"))

(define HO_FORM_NAMES
  (list "map" "map-indexed" "filter" "reduce"
        "some" "every?" "for-each"))

(define special-form? :effects []
  (fn ((name :as string))
    (contains? SPECIAL_FORM_NAMES name)))

(define ho-form? :effects []
  (fn ((name :as string))
    (contains? HO_FORM_NAMES name)))


;; --------------------------------------------------------------------------
;; aser-special — evaluate special/HO forms in aser mode
;; --------------------------------------------------------------------------
;;
;; Control flow forms evaluate conditions normally but render branches
;; through aser (serializing tags/components instead of rendering HTML).
;; Definition forms evaluate for side effects and return nil.

(define aser-special :effects [render]
  (fn ((name :as string) (expr :as list) (env :as dict))
    (let ((args (rest expr)))
      (cond
        ;; if — evaluate condition, aser chosen branch
        (= name "if")
          (if (trampoline (eval-expr (first args) env))
            (aser (nth args 1) env)
            (if (> (len args) 2)
              (aser (nth args 2) env)
              nil))

        ;; when — evaluate condition, aser body if true
        (= name "when")
          (if (not (trampoline (eval-expr (first args) env)))
            nil
            (let ((result nil))
              (for-each (fn (body) (set! result (aser body env)))
                        (rest args))
              result))

        ;; cond — evaluate conditions, aser matching branch
        (= name "cond")
          (let ((branch (eval-cond args env)))
            (if branch (aser branch env) nil))

        ;; case — evaluate match value, check each pair
        (= name "case")
          (let ((match-val (trampoline (eval-expr (first args) env)))
                (clauses (rest args)))
            (eval-case-aser match-val clauses env))

        ;; let / let*
        (or (= name "let") (= name "let*"))
          (let ((local (process-bindings (first args) env))
                (result nil))
            (for-each (fn (body) (set! result (aser body local)))
                      (rest args))
            result)

        ;; begin / do
        (or (= name "begin") (= name "do"))
          (let ((result nil))
            (for-each (fn (body) (set! result (aser body env))) args)
            result)

        ;; and — short-circuit
        (= name "and")
          (let ((result true))
            (some (fn (arg)
                    (set! result (trampoline (eval-expr arg env)))
                    (not result))
                  args)
            result)

        ;; or — short-circuit
        (= name "or")
          (let ((result false))
            (some (fn (arg)
                    (set! result (trampoline (eval-expr arg env)))
                    result)
                  args)
            result)

        ;; map — evaluate function and collection, map through aser
        (= name "map")
          (let ((f (trampoline (eval-expr (first args) env)))
                (coll (trampoline (eval-expr (nth args 1) env))))
            (map (fn (item)
                   (if (lambda? f)
                     (let ((local (env-merge (lambda-closure f) env)))
                       (env-bind! local (first (lambda-params f)) item)
                       (aser (lambda-body f) local))
                     (cek-call f (list item))))
                 coll))

        ;; map-indexed
        (= name "map-indexed")
          (let ((f (trampoline (eval-expr (first args) env)))
                (coll (trampoline (eval-expr (nth args 1) env))))
            (map-indexed (fn (i item)
                           (if (lambda? f)
                             (let ((local (env-merge (lambda-closure f) env)))
                               (env-bind! local (first (lambda-params f)) i)
                               (env-bind! local (nth (lambda-params f) 1) item)
                               (aser (lambda-body f) local))
                             (cek-call f (list i item))))
                         coll))

        ;; for-each — evaluate for side effects, aser each body
        (= name "for-each")
          (let ((f (trampoline (eval-expr (first args) env)))
                (coll (trampoline (eval-expr (nth args 1) env)))
                (results (list)))
            (for-each (fn (item)
                        (if (lambda? f)
                          (let ((local (env-merge (lambda-closure f) env)))
                            (env-bind! local (first (lambda-params f)) item)
                            (append! results (aser (lambda-body f) local)))
                          (cek-call f (list item))))
                      coll)
            (if (empty? results) nil results))

        ;; defisland — evaluate AND serialize (client needs the definition)
        (= name "defisland")
          (do (trampoline (eval-expr expr env))
              (serialize expr))

        ;; Definition forms — evaluate for side effects
        (or (= name "define") (= name "defcomp") (= name "defmacro")
            (= name "defstyle") (= name "defhandler") (= name "defpage")
            (= name "defquery") (= name "defaction") (= name "defrelation")
            (= name "deftype") (= name "defeffect"))
          (do (trampoline (eval-expr expr env)) nil)

        ;; scope — unified render-time dynamic scope
        (= name "scope")
          (let ((scope-name (trampoline (eval-expr (first args) env)))
                (rest-args (rest args))
                (scope-val nil)
                (body-args 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-args (slice rest-args 2)))
              (set! body-args rest-args))
            (scope-push! scope-name scope-val)
            (let ((result nil))
              (for-each (fn (body) (set! result (aser body env)))
                        body-args)
              (scope-pop! scope-name)
              result))

        ;; provide — sugar for scope with value
        (= name "provide")
          (let ((prov-name (trampoline (eval-expr (first args) env)))
                (prov-val (trampoline (eval-expr (nth args 1) env)))
                (result nil))
            (scope-push! prov-name prov-val)
            (for-each (fn (body) (set! result (aser body env)))
                      (slice args 2))
            (scope-pop! prov-name)
            result)

        ;; context — scope lookup (uses hashtable stack, not CEK kont)
        (= name "context")
          (let ((ctx-name (trampoline (eval-expr (first args) env)))
                (default-val (if (>= (len args) 2)
                               (trampoline (eval-expr (nth args 1) env))
                               nil)))
            (let ((val (scope-peek ctx-name)))
              (if (nil? val) default-val val)))

        ;; emit! — scope accumulator
        (= name "emit!")
          (let ((emit-name (trampoline (eval-expr (first args) env)))
                (emit-val (trampoline (eval-expr (nth args 1) env))))
            (scope-emit! emit-name emit-val)
            nil)

        ;; emitted — collect accumulated scope values
        (= name "emitted")
          (let ((emit-name (trampoline (eval-expr (first args) env))))
            (or (scope-peek emit-name) (list)))

        ;; Everything else — evaluate normally
        :else
          (trampoline (eval-expr expr env))))))


;; Helper: case dispatch for aser mode
(define eval-case-aser :effects [render]
  (fn (match-val (clauses :as list) (env :as dict))
    (if (< (len clauses) 2)
      nil
      (let ((test (first clauses))
            (body (nth clauses 1)))
        (if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
                (and (= (type-of test) "symbol")
                     (or (= (symbol-name test) ":else")
                         (= (symbol-name test) "else"))))
          (aser body env)
          (if (= match-val (trampoline (eval-expr test env)))
            (aser body env)
            (eval-case-aser match-val (slice clauses 2) env)))))))


;; --------------------------------------------------------------------------
;; Platform interface — SX wire adapter
;; --------------------------------------------------------------------------
;;
;; From eval.sx:
;;   eval-expr, trampoline, call-lambda, expand-macro
;;   env-has?, env-get, env-set!, env-merge, callable?, lambda?, component?,
;;   macro?, island?, primitive?, get-primitive, component-name
;;   lambda-closure, lambda-params, lambda-body
;;
;; From render.sx:
;;   HTML_TAGS, eval-cond, process-bindings
;;
;; From parser.sx:
;;   serialize (= sx-serialize)
;;
;; From signals.sx (optional):
;;   invoke
;; --------------------------------------------------------------------------