

(import (web boot-helpers))

(define-library (web adapter-sx)
  (export
    render-to-sx
    aser
    aser-list
    aser-reserialize
    aser-fragment
    aser-call
    aser-expand-component
    SPECIAL_FORM_NAMES
    HO_FORM_NAMES
    special-form?
    ho-form?
    aser-special
    eval-case-aser)
  (begin

(define
  render-to-sx
  :effects (render)
  (fn
    (expr (env :as dict))
    (let
      ((result (aser expr env)))
      (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))
    (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" (do (scope-emit! "element-attrs" (spread-attrs expr)) nil) :else expr)))
      (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
            (= name "<>")
            (aser-fragment args env)
            (= name "raw!")
            (aser-call "raw!" args env)
            (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"))
                  (not (= (component-affinity comp) "client")))
                (aser-expand-component comp args env)
                :else (aser-call name args env)))
            (= name "lake")
            (aser-call name args env)
            (= name "marsh")
            (aser-call name args env)
            (= name "error-boundary")
            (let
              ((has-fallback (> (len args) 1)))
              (let
                ((body-exprs (if has-fallback (rest args) args))
                  (err-str nil))
                (let
                  ((rendered (try-catch (fn () (join "" (map (fn (x) (let ((v (aser x env))) (cond (= (type-of v) "sx-expr") (sx-expr-source v) (nil? v) "" :else (serialize v)))) body-exprs))) (fn (err) (set! err-str (str err)) nil))))
                  (if
                    rendered
                    (make-sx-expr (str "(error-boundary " rendered ")"))
                    (make-sx-expr
                      (str
                        "(div :data-sx-boundary \"true\" "
                        "(div :class \"sx-render-error\" "
                        ":style \"color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;\" "
                        "\"Render error: "
                        (replace (replace err-str "\"" "'") "\\" "\\\\")
                        "\"))"))))))
            (contains? HTML_TAGS name)
            (aser-call name args env)
            (or (special-form? name) (ho-form? name))
            (aser-special name expr env)
            (and (env-has? env name) (macro? (env-get env name)))
            (aser (expand-macro (env-get env name) args env) env)
            :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)))))))))))

(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))
                        (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))
    (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))
              (= (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)
              :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))
    (let
      ((attr-parts (list)) (child-parts (list)) (skip false) (i 0))
      (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))
                    (= (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)
                    :else (append! child-parts (serialize val))))
                (set! i (inc i))))))
        args)
      (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) ")"))))))

(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)))
      (for-each (fn (p) (env-bind! local p nil)) params)
      (for-each
        (fn
          (arg)
          (if
            skip
            (do (set! skip false) (set! i (inc i)))
            (if
              (and (= (type-of arg) "keyword") (< (inc i) (len args)))
              (do
                (env-bind!
                  local
                  (keyword-name arg)
                  (aser (nth args (inc i)) env))
                (set! skip true)
                (set! i (inc i)))
              (do (append! children arg) (set! i (inc i))))))
        args)
      (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 (component-body comp) local))))

(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)))

(define
  aser-special
  :effects (render)
  (fn
    ((name :as string) (expr :as list) (env :as dict))
    (let
      ((args (rest expr)))
      (cond
        (= name "if")
        (if
          (trampoline (eval-expr (first args) env))
          (aser (nth args 1) env)
          (if (> (len args) 2) (aser (nth args 2) env) nil))
        (= 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))
        (= name "cond")
        (let
          ((branch (eval-cond args env)))
          (if branch (aser branch env) nil))
        (= name "case")
        (let
          ((match-val (trampoline (eval-expr (first args) env)))
            (clauses (rest args)))
          (eval-case-aser match-val clauses env))
        (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)
        (or (= name "begin") (= name "do"))
        (let
          ((result nil))
          (for-each (fn (body) (set! result (aser body env))) args)
          result)
        (= name "and")
        (let
          ((result true))
          (some
            (fn
              (arg)
              (set! result (trampoline (eval-expr arg env)))
              (not result))
            args)
          result)
        (= name "or")
        (let
          ((result false))
          (some
            (fn
              (arg)
              (set! result (trampoline (eval-expr arg env)))
              result)
            args)
          result)
        (= name "map")
        (let
          ((f (trampoline (eval-expr (first args) env)))
            (coll (trampoline (eval-expr (nth args 1) env))))
          (let
            ((results (map (fn (item) (if (lambda? f) (let ((local (env-extend (lambda-closure f)))) (env-bind! local (first (lambda-params f)) item) (aser (lambda-body f) local)) (cek-call f (list item)))) coll)))
            (aser-fragment results env)))
        (= 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))
        (= 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))
        (= name "defisland")
        (do (trampoline (eval-expr expr env)) (serialize expr))
        (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)
        (= name "scope")
        (let
          ((scope-name (trampoline (eval-expr (first args) env)))
            (rest-args (rest args))
            (scope-val nil)
            (body-args nil))
          (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))
        (= 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)
        (= 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)))
        (= 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)
        (= name "emitted")
        (let
          ((emit-name (trampoline (eval-expr (first args) env))))
          (or (scope-peek emit-name) (list)))
        :else (trampoline (eval-expr expr env))))))

(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)))))))


)) ;; end define-library

;; Re-export to global namespace for backward compatibility
(import (web adapter-sx))
