(define
  render-to-html
  :effects (render)
  (fn
    (expr (env :as dict))
    (set-render-active! true)
    (case
      (type-of expr)
      "nil"
      ""
      "string"
      (escape-html expr)
      "number"
      (str expr)
      "boolean"
      (if expr "true" "false")
      "list"
      (if (empty? expr) "" (render-list-to-html expr env))
      "symbol"
      (render-value-to-html (trampoline (eval-expr expr env)) env)
      "keyword"
      (escape-html (keyword-name expr))
      "raw-html"
      (raw-html-content expr)
      "spread"
      (do (scope-emit! "element-attrs" (spread-attrs expr)) "")
      "thunk"
      (render-to-html (thunk-expr expr) (thunk-env expr))
      :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 (scope-emit! "element-attrs" (spread-attrs val)) "")
      "thunk"
      (render-to-html (thunk-expr val) (thunk-env val))
      :else (escape-html (str val)))))

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

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

(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"))
          (join "" (map (fn (x) (render-value-to-html x env)) expr))
          (let
            ((name (symbol-name head)) (args (rest expr)))
            (cond
              (= name "<>")
              (join "" (map (fn (x) (render-to-html x env)) args))
              (= name "raw!")
              (join
                ""
                (map (fn (x) (str (trampoline (eval-expr x env)))) args))
              (= name "lake")
              (render-html-lake args env)
              (= name "marsh")
              (render-html-marsh args env)
              (or
                (= name "portal")
                (= name "error-boundary")
                (= name "promise-delayed"))
              (join "" (map (fn (x) (render-to-html x env)) args))
              (contains? HTML_TAGS name)
              (render-html-element name args env)
              (and
                (starts-with? name "~")
                (env-has? env name)
                (island? (env-get env name)))
              (render-html-island (env-get env name) args env)
              (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-html-form? name)
              (dispatch-html-form name expr env)
              (and (env-has? env name) (macro? (env-get env name)))
              (render-to-html (expand-macro (env-get env name) args env) env)
              :else (render-value-to-html (trampoline (eval-expr expr env)) env))))))))

(define
  dispatch-html-form
  :effects (render)
  (fn
    ((name :as string) (expr :as list) (env :as dict))
    (cond
      (= 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) "")))
      (= 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))))))
      (= name "cond")
      (let
        ((branch (eval-cond (rest expr) env)))
        (if branch (render-to-html branch env) ""))
      (= name "case")
      (render-to-html (trampoline (eval-expr expr env)) env)
      (= name "letrec")
      (let
        ((bindings (nth expr 1))
          (body (slice expr 2))
          (local (env-extend env)))
        (for-each
          (fn
            (pair)
            (let
              ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
              (env-bind! local pname nil)))
          bindings)
        (for-each
          (fn
            (pair)
            (let
              ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
              (env-set!
                local
                pname
                (trampoline (eval-expr (nth pair 1) local)))))
          bindings)
        (when
          (> (len body) 1)
          (for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
        (render-to-html (last body) local))
      (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))))))
      (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-form? name)
      (do (trampoline (eval-expr expr env)) "")
      (= 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)))
      (= 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)))
      (= name "filter")
      (render-to-html (trampoline (eval-expr expr env)) env)
      (= 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)))
      (= name "scope")
      (let
        ((scope-name (trampoline (eval-expr (nth expr 1) env)))
          (rest-args (slice expr 2))
          (scope-val nil)
          (body-exprs 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-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))
      (= 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))
      :else (render-value-to-html (trampoline (eval-expr expr env)) env))))

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

(define
  render-html-component
  :effects (render)
  (fn
    ((comp :as component) (args :as list) (env :as dict))
    (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)
      (let
        ((local (env-merge (component-closure comp) env)))
        (for-each
          (fn
            (p)
            (env-bind!
              local
              p
              (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
          (component-params comp))
        (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) " />")
        (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))
              (scope-emitted "element-attrs"))
            (scope-pop! "element-attrs")
            (str "<" tag (render-attrs attrs) ">" content "</" tag ">")))))))

(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)
      (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))
            (scope-emitted "element-attrs"))
          (scope-pop! "element-attrs")
          (str
            "<"
            lake-tag
            (render-attrs lake-attrs)
            ">"
            content
            "</"
            lake-tag
            ">"))))))

(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)
      (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))
            (scope-emitted "element-attrs"))
          (scope-pop! "element-attrs")
          (str
            "<"
            marsh-tag
            (render-attrs marsh-attrs)
            ">"
            content
            "</"
            marsh-tag
            ">"))))))

(define
  render-html-island
  :effects (render)
  (fn
    ((island :as island) (args :as list) (env :as dict))
    (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)
      (let
        ((local (env-merge (component-closure island) env))
          (island-name (component-name island)))
        (for-each
          (fn
            (p)
            (env-bind!
              local
              p
              (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
          (component-params island))
        (when
          (component-has-children? island)
          (env-bind!
            local
            "children"
            (make-raw-html
              (join "" (map (fn (c) (render-to-html c env)) children)))))
        (let
          ((body-html (render-to-html (component-body island) local))
            (state-sx (serialize-island-state kwargs)))
          (str
            "<span data-sx-island=\""
            (escape-attr island-name)
            "\""
            (if
              state-sx
              (str " data-sx-state=\"" (escape-attr state-sx) "\"")
              "")
            ">"
            body-html
            "</span>"))))))

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