(import (sx dom))
(import (sx browser))
(import (web adapter-dom))

(define-library
  (web boot-helpers)
  (export
    _sx-bound-prefix
    mark-processed!
    is-processed?
    clear-processed!
    callable?
    to-kebab
    sx-load-components
    call-expr
    base-env
    get-render-env
    merge-envs
    sx-render-with-env
    parse-env-attr
    store-env-attr
    resolve-mount-target
    remove-head-element
    set-sx-comp-cookie
    clear-sx-comp-cookie
    log-parse-error
    loaded-component-names
    csrf-token
    validate-for-request
    build-request-body
    abort-previous-target
    abort-previous
    track-controller
    track-controller-target
    new-abort-controller
    abort-signal
    apply-optimistic
    revert-optimistic
    dom-has-attr?
    show-indicator
    disable-elements
    clear-loading-state
    abort-error?
    promise-catch
    fetch-request
    fetch-location
    fetch-and-restore
    fetch-preload
    fetch-streaming
    dom-parse-html-document
    dom-body-inner-html
    create-script-clone
    cross-origin?
    browser-scroll-to
    with-transition
    event-source-connect
    event-source-listen
    bind-boost-link
    bind-boost-form
    bind-client-route-click
    sw-post-message
    try-parse-json
    strip-component-scripts
    extract-response-css
    sx-render
    sx-hydrate
    sx-process-scripts
    select-from-container
    children-to-fragment
    select-html-from-doc
    register-io-deps
    resolve-page-data
    parse-sx-data
    try-eval-content
    try-async-eval-content
    try-rerender-page
    execute-action
    bind-preload
    persist-offline-data
    retrieve-offline-data)
  (begin
    (define _sx-bound-prefix "_sxBound")
    (define
      mark-processed!
      (fn (el key) (host-set! el (str _sx-bound-prefix key) true)))
    (define
      is-processed?
      (fn
        (el key)
        (let
          ((v (host-get el (str _sx-bound-prefix key))))
          (if v true false))))
    (define
      clear-processed!
      (fn (el key) (host-set! el (str _sx-bound-prefix key) nil)))
    (define
      callable?
      (fn
        (v)
        (let
          ((t (type-of v)))
          (or (= t "lambda") (= t "function") (= t "continuation")))))
    (define
      to-kebab
      (fn
        (s)
        "Convert camelCase to kebab-case."
        (let
          ((result (list)) (i 0))
          (let
            loop
            ((i 0))
            (when
              (< i (len s))
              (let
                ((ch (nth s i)))
                (if
                  (and (>= ch "A") (<= ch "Z"))
                  (do
                    (when (> i 0) (append! result "-"))
                    (append! result (lower ch)))
                  (append! result ch))
                (loop (+ i 1)))))
          (join "" result))))
    (define
      sx-load-components
      (fn
        (text)
        "Parse and evaluate component definitions from text."
        (when
          (and text (> (len text) 0))
          (let
            ((exprs (sx-parse text)))
            (for-each (fn (expr) (cek-eval expr)) exprs)))))
    (define
      call-expr
      (fn
        (expr-text env-bindings)
        "Parse and evaluate an SX expression string."
        (let
          ((exprs (sx-parse expr-text)))
          (when (not (empty? exprs)) (cek-eval (first exprs))))))
    (define
      base-env
      (fn () "Return the current global environment." (global-env)))
    (define
      get-render-env
      (fn
        (extra)
        "Get the rendering environment (global env, optionally merged with extra)."
        (let
          ((env (base-env)))
          (if (and extra (not (nil? extra))) (env-merge env extra) env))))
    (define
      merge-envs
      (fn
        (a b)
        "Merge two environments."
        (if (and a b) (env-merge a b) (or a b (global-env)))))
    (define
      sx-render-with-env
      (fn
        (source extra-env)
        "Parse SX source and render to DOM fragment."
        (let
          ((doc (host-global "document"))
            (frag (host-call doc "createDocumentFragment"))
            (exprs (sx-parse source)))
          (for-each
            (fn
              (expr)
              (let
                ((html (render-to-html expr)))
                (when
                  (and html (> (len html) 0))
                  (let
                    ((temp (host-call doc "createElement" "template")))
                    (host-set! temp "innerHTML" html)
                    (host-call frag "appendChild" (host-get temp "content"))))))
            exprs)
          frag)))
    (define
      parse-env-attr
      (fn (el) "Parse data-sx-env attribute (JSON key-value pairs)." nil))
    (define store-env-attr (fn (el base new-env) nil))
    (define
      resolve-mount-target
      (fn
        (target)
        "Resolve a CSS selector string to a DOM element."
        (if (string? target) (dom-query target) target)))
    (define
      remove-head-element
      (fn
        (sel)
        "Remove a <head> element matching selector."
        (let ((el (dom-query sel))) (when el (dom-remove el)))))
    (define
      set-sx-comp-cookie
      (fn (hash) (set-cookie "sx-components" hash)))
    (define clear-sx-comp-cookie (fn () (set-cookie "sx-components" "")))
    (define
      log-parse-error
      (fn
        (label text err)
        (log-error (str "Parse error in " label ": " err))))
    (define
      loaded-component-names
      (fn
        ()
        (let
          ((scripts (dom-query-all (dom-body) "script[data-components]"))
            (names (list)))
          (for-each
            (fn
              (script)
              (let
                ((text (or (dom-get-attr script "data-components") "")))
                (when
                  (> (len text) 0)
                  (for-each
                    (fn
                      (name)
                      (when
                        (> (len (trim name)) 0)
                        (append! names (trim name))))
                    (split text ",")))))
            scripts)
          names)))
    (define
      csrf-token
      (fn
        ()
        (let
          ((meta (dom-query "meta[name=\"csrf-token\"]")))
          (if meta (dom-get-attr meta "content") nil))))
    (define validate-for-request (fn (el) true))
    (define
      build-request-body
      (fn
        (el method url)
        (let
          ((m (upper method)))
          (if
            (or (= m "GET") (= m "HEAD"))
            (if
              (and el (= (upper (or (dom-tag-name el) "")) "FORM"))
              (let
                ((fd (host-new "FormData" el))
                  (params (host-new "URLSearchParams" fd))
                  (qs (host-call params "toString")))
                (dict
                  "url"
                  (if
                    (and qs (> (len qs) 0))
                    (str url (if (contains? url "?") "&" "?") qs)
                    url)
                  "body"
                  nil
                  "content-type"
                  nil))
              (dict "url" url "body" nil "content-type" nil))
            (if
              (and el (= (upper (or (dom-tag-name el) "")) "FORM"))
              (let
                ((enctype (or (dom-get-attr el "enctype") "application/x-www-form-urlencoded")))
                (if
                  (= enctype "multipart/form-data")
                  (let
                    ((fd (host-new "FormData" el)))
                    (dict "url" url "body" fd "content-type" nil))
                  (let
                    ((fd (host-new "FormData" el))
                      (params (host-new "URLSearchParams" fd)))
                    (dict
                      "url"
                      url
                      "body"
                      (host-call params "toString")
                      "content-type"
                      "application/x-www-form-urlencoded"))))
              (dict "url" url "body" nil "content-type" nil))))))
    (define abort-previous-target (fn (el) nil))
    (define abort-previous (fn (el) nil))
    (define track-controller (fn (el ctrl) nil))
    (define track-controller-target (fn (el ctrl) nil))
    (define new-abort-controller (fn () (host-new "AbortController")))
    (define abort-signal (fn (ctrl) (host-get ctrl "signal")))
    (define apply-optimistic (fn (el) nil))
    (define revert-optimistic (fn (el) nil))
    (define dom-has-attr? (fn (el name) (host-call el "hasAttribute" name)))
    (define
      show-indicator
      (fn
        (el)
        (let
          ((indicator-sel (dom-get-attr el "sx-indicator")))
          (when
            indicator-sel
            (let
              ((indicator (dom-query indicator-sel)))
              (when
                indicator
                (dom-remove-class indicator "hidden")
                (dom-add-class indicator "sx-indicator-visible"))))
          indicator-sel)))
    (define
      disable-elements
      (fn
        (el)
        (let
          ((disable-sel (dom-get-attr el "sx-disabled-elt")))
          (if
            disable-sel
            (let
              ((elts (dom-query-all (dom-body) disable-sel)))
              (for-each (fn (e) (dom-set-attr e "disabled" "")) elts)
              elts)
            (list)))))
    (define
      clear-loading-state
      (fn
        (el indicator disabled-elts)
        (dom-remove-class el "sx-request")
        (dom-remove-attr el "aria-busy")
        (when
          indicator
          (let
            ((ind (dom-query indicator)))
            (when
              ind
              (dom-add-class ind "hidden")
              (dom-remove-class ind "sx-indicator-visible"))))
        (when
          disabled-elts
          (for-each (fn (e) (dom-remove-attr e "disabled")) disabled-elts))))
    (define abort-error? (fn (err) (= (host-get err "name") "AbortError")))
    (define
      promise-catch
      (fn (p f) (let ((cb (host-callback f))) (host-call p "catch" cb))))
    (define
      fetch-request
      (fn
        (config success-fn error-fn)
        (let
          ((url (get config "url"))
            (method (or (get config "method") "GET"))
            (headers (or (get config "headers") (dict)))
            (body (get config "body"))
            (signal (get config "signal"))
            (preloaded (get config "preloaded")))
          (if
            preloaded
            (success-fn true 200 (fn (name) nil) preloaded)
            (let
              ((h (host-new "Headers")) (js-opts (host-new "Object")))
              (for-each
                (fn (k) (host-call h "set" k (get headers k)))
                (keys headers))
              (host-set! js-opts "method" method)
              (host-set! js-opts "headers" h)
              (when body (host-set! js-opts "body" body))
              (when signal (host-set! js-opts "signal" signal))
              (promise-then
                (host-call (dom-window) "fetch" url js-opts)
                (fn
                  (response)
                  (let
                    ((ok (host-get response "ok"))
                      (status (host-get response "status"))
                      (get-header
                        (fn
                          (name)
                          (host-call (host-get response "headers") "get" name))))
                    (promise-then
                      (host-call response "text")
                      (fn (text) (success-fn ok status get-header text))
                      error-fn)))
                error-fn))))))
    (define
      fetch-location
      (fn
        (url)
        (let
          ((target (or (dom-query "[sx-boost]") (dom-query "#main-panel"))))
          (when target (browser-navigate url)))))
    (define
      fetch-and-restore
      (fn
        (main url headers scroll-y)
        (fetch-request
          (dict
            "url"
            url
            "method"
            "GET"
            "headers"
            headers
            "body"
            nil
            "signal"
            nil)
          (fn
            (resp-ok status get-header text)
            (when
              resp-ok
              (let
                ((ct (or (get-header "content-type") "")))
                (if
                  (contains? ct "text/html")
                  (let
                    ((parser (host-new "DOMParser"))
                      (doc
                        (host-call parser "parseFromString" text "text/html"))
                      (content (host-call doc "querySelector" "#sx-content")))
                    (if
                      content
                      (dom-set-inner-html main (host-get content "innerHTML"))
                      (dom-set-inner-html main text)))
                  (let
                    ((container (dom-create-element "div")))
                    (let
                      ((rendered (sx-render text)))
                      (when
                        rendered
                        (dom-append container rendered)
                        (process-oob-swaps
                          container
                          (fn
                            (t oob (s :as string))
                            (dispose-islands-in t)
                            (swap-dom-nodes
                              t
                              (if
                                (= s "innerHTML")
                                (children-to-fragment oob)
                                oob)
                              s)
                            (post-swap t)))
                        (let
                          ((content (select-from-container container "#sx-content")))
                          (if
                            content
                            (do
                              (dispose-islands-in main)
                              (dom-set-inner-html main "")
                              (dom-append main content))
                            (do
                              (dispose-islands-in main)
                              (dom-set-inner-html
                                main
                                (dom-get-inner-html container))))))))))
              (post-swap main)
              (host-call (dom-window) "scrollTo" 0 scroll-y)))
          (fn (err) (log-warn (str "fetch-and-restore error: " err))))))
    (define
      fetch-preload
      (fn
        (url headers cache)
        (fetch-request
          (dict
            "url"
            url
            "method"
            "GET"
            "headers"
            headers
            "body"
            nil
            "signal"
            nil)
          (fn
            (resp-ok status get-header text)
            (when resp-ok (preload-cache-set cache url text)))
          (fn (err) nil))))
    (define
      fetch-streaming
      (fn
        (target pathname headers swap-fn)
        (fetch-and-restore target pathname headers 0)))
    (define
      dom-parse-html-document
      (fn
        (text)
        (let
          ((parser (host-new "DOMParser")))
          (host-call parser "parseFromString" text "text/html"))))
    (define
      dom-body-inner-html
      (fn (doc) (host-get (host-get doc "body") "innerHTML")))
    (define
      create-script-clone
      (fn
        (dead)
        (let
          ((doc (host-global "document"))
            (live (host-call doc "createElement" "script")))
          (let
            ((attrs (host-get dead "attributes")))
            (let
              loop
              ((i 0))
              (when
                (< i (host-get attrs "length"))
                (let
                  ((attr (host-call attrs "item" i)))
                  (host-call
                    live
                    "setAttribute"
                    (host-get attr "name")
                    (host-get attr "value"))
                  (loop (+ i 1))))))
          (host-set! live "textContent" (host-get dead "textContent"))
          live)))
    (define
      cross-origin?
      (fn
        (url)
        (if
          (or (starts-with? url "http://") (starts-with? url "https://"))
          (not (starts-with? url (browser-location-origin)))
          false)))
    (define
      browser-scroll-to
      (fn (x y) (host-call (dom-window) "scrollTo" x y)))
    (define
      with-transition
      (fn
        (enabled thunk)
        (if
          (and
            enabled
            (host-get (host-global "document") "startViewTransition"))
          (host-call
            (host-global "document")
            "startViewTransition"
            (host-callback thunk))
          (thunk))))
    (define
      event-source-connect
      (fn
        (url el)
        (let
          ((source (host-new "EventSource" url)))
          (host-set! source "_sxElement" el)
          source)))
    (define
      event-source-listen
      (fn
        (source event-name handler)
        (host-call
          source
          "addEventListener"
          event-name
          (host-callback (fn (e) (handler e))))))
    (define
      bind-boost-link
      (fn
        (el href)
        (dom-listen
          el
          "click"
          (fn
            (e)
            (when
              (not (event-modifier-key? e))
              (prevent-default e)
              (when
                (not (dom-has-attr? el "sx-get"))
                (dom-set-attr el "sx-get" href))
              (when
                (not (dom-has-attr? el "sx-push-url"))
                (dom-set-attr el "sx-push-url" "true"))
              (execute-request el nil nil))))))
    (define
      bind-boost-form
      (fn
        (form method action)
        (dom-listen
          form
          "submit"
          (fn (e) (prevent-default e) (execute-request form nil nil)))))
    (define
      bind-client-route-click
      (fn
        (link href fallback-fn)
        (dom-listen
          link
          "click"
          (fn
            (e)
            (when
              (not (event-modifier-key? e))
              (prevent-default e)
              (let
                ((boost-el (dom-query "[sx-boost]"))
                  (target-sel
                    (if
                      boost-el
                      (let
                        ((attr (dom-get-attr boost-el "sx-boost")))
                        (if
                          (and attr (not (= attr "true")))
                          attr
                          "#sx-content"))
                      "#sx-content")))
                (if
                  (try-client-route (url-pathname href) target-sel)
                  (do
                    (save-scroll-position)
                    (browser-push-state nil "" href)
                    (browser-scroll-to 0 0))
                  (do
                    (log-info (str "sx:route server fetch " href))
                    (dom-set-attr link "sx-get" href)
                    (dom-set-attr link "sx-target" target-sel)
                    (dom-set-attr link "sx-select" target-sel)
                    (dom-set-attr link "sx-push-url" "true")
                    (execute-request link nil nil)))))))))
    (define sw-post-message (fn (msg) nil))
    (define try-parse-json (fn (text) (json-parse text)))
    (define
      strip-component-scripts
      (fn
        (text)
        (let
          ((result text)
            (start-tag "<script type=\"text/sx\" data-components>")
            (end-tag "</script>"))
          (let
            loop
            ((s result))
            (let
              ((start-idx (index-of s start-tag)))
              (if
                (= start-idx -1)
                (set! result s)
                (let
                  ((after-start (+ start-idx (len start-tag)))
                    (rest-str (slice s (+ start-idx (len start-tag)))))
                  (let
                    ((end-offset (index-of rest-str end-tag)))
                    (if
                      (= end-offset -1)
                      (set! result s)
                      (let
                        ((comp-text (slice rest-str 0 end-offset))
                          (before (slice s 0 start-idx))
                          (after
                            (slice rest-str (+ end-offset (len end-tag)))))
                        (sx-load-components comp-text)
                        (loop (str before after)))))))))
          result)))
    (define
      extract-response-css
      (fn
        (text)
        (let
          ((result text)
            (start-tag "<style data-sx-css>")
            (end-tag "</style>"))
          (let
            loop
            ((s result))
            (let
              ((start-idx (index-of s start-tag)))
              (if
                (= start-idx -1)
                (set! result s)
                (let
                  ((rest-str (slice s (+ start-idx (len start-tag)))))
                  (let
                    ((end-offset (index-of rest-str end-tag)))
                    (if
                      (= end-offset -1)
                      (set! result s)
                      (let
                        ((css-text (slice rest-str 0 end-offset))
                          (before (slice s 0 start-idx))
                          (after
                            (slice rest-str (+ end-offset (len end-tag)))))
                        (let
                          ((doc (host-global "document"))
                            (style-el (host-call doc "createElement" "style")))
                          (host-set! style-el "textContent" css-text)
                          (dom-append-to-head style-el))
                        (loop (str before after)))))))))
          result)))
    (define
      sx-render
      (fn
        (text)
        (let
          ((doc (host-global "document"))
            (frag (host-call doc "createDocumentFragment"))
            (exprs (sx-parse text)))
          (scope-push! "sx-render-markers" true)
          (for-each
            (fn
              (expr)
              (let
                ((result (try-catch (fn () (render-to-dom expr (get-render-env nil) nil)) (fn (err) (log-error (str "sx-render: " err)) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:4px;margin:0.25rem 0;") (dom-set-text-content el (str "Render error: " err)) el)))))
                (when result (dom-append frag result))))
            exprs)
          (scope-pop! "sx-render-markers")
          frag)))
    (define
      sx-hydrate
      (fn (root) (sx-hydrate-elements (or root (dom-body)))))
    (define
      sx-process-scripts
      (fn
        (root)
        (let
          ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]")))
          (for-each
            (fn
              (s)
              (when
                (not (is-processed? s "sx-script"))
                (mark-processed! s "sx-script")
                (let
                  ((text (host-get s "textContent")))
                  (when
                    (and text (> (len text) 0))
                    (let
                      ((exprs (sx-parse text)))
                      (for-each
                        (fn
                          (expr)
                          (try-catch
                            (fn () (cek-eval expr))
                            (fn
                              (err)
                              (log-error (str "sx-process-scripts: " err)))))
                        exprs))))))
            scripts))))
    (define
      select-from-container
      (fn
        (container selector)
        (if
          selector
          (let
            ((selected (dom-query container selector)))
            (if
              selected
              (children-to-fragment selected)
              (children-to-fragment container)))
          (children-to-fragment container))))
    (define
      children-to-fragment
      (fn
        (el)
        (let
          ((doc (host-global "document"))
            (frag (host-call doc "createDocumentFragment")))
          (let
            loop
            ()
            (let
              ((child (dom-first-child el)))
              (when child (dom-append frag child) (loop))))
          frag)))
    (define
      select-html-from-doc
      (fn
        (doc selector)
        (if
          selector
          (let
            ((el (dom-query doc selector)))
            (if el (dom-inner-html el) (dom-body-inner-html doc)))
          (dom-body-inner-html doc))))
    (define register-io-deps (fn (deps) nil))
    (define resolve-page-data (fn (page-name params callback) nil))
    (define
      parse-sx-data
      (fn
        (text)
        (if
          (and text (> (len text) 0))
          (let
            ((exprs (sx-parse text)))
            (if (not (empty? exprs)) (first exprs) nil))
          nil)))
    (define
      try-eval-content
      (fn
        (content-src env)
        (let
          ((exprs (sx-parse content-src)))
          (if
            (empty? exprs)
            nil
            (let
              ((frag (create-fragment)))
              (for-each
                (fn
                  (expr)
                  (let
                    ((result (render-to-dom expr env nil)))
                    (when result (dom-append frag result))))
                exprs)
              frag)))))
    (define
      try-async-eval-content
      (fn (content-src env callback) (try-eval-content content-src env)))
    (define try-rerender-page (fn () nil))
    (define execute-action (fn () nil))
    (define bind-preload (fn () nil))
    (define persist-offline-data (fn () nil))
    (define retrieve-offline-data (fn () nil))))

;; Re-export to global env
(import (web boot-helpers))
