(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 "native-fn") (= 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))