(import (sx dom))
(import (sx bytecode))
(import (sx browser))
(import (web boot-helpers))
(import (web adapter-dom))
(import (sx signals))
(import (sx signals-web))
(import (web router))
(import (web page-helpers))
(import (web orchestration))

(import (sx render))

(define
  HEAD_HOIST_SELECTOR
  "meta, title, link[rel='canonical'], script[type='application/ld+json']")

(define
  hoist-head-elements-full
  :effects (mutation io)
  (fn
    (root)
    (let
      ((els (dom-query-all root HEAD_HOIST_SELECTOR)))
      (for-each
        (fn
          (el)
          (let
            ((tag (lower (dom-tag-name el))))
            (cond
              (= tag "title")
              (do
                (set-document-title (dom-text-content el))
                (dom-remove-child (dom-parent el) el))
              (= tag "meta")
              (do
                (let
                  ((name (dom-get-attr el "name"))
                    (prop (dom-get-attr el "property")))
                  (when
                    name
                    (remove-head-element (str "meta[name=\"" name "\"]")))
                  (when
                    prop
                    (remove-head-element (str "meta[property=\"" prop "\"]"))))
                (dom-remove-child (dom-parent el) el)
                (dom-append-to-head el))
              (and (= tag "link") (= (dom-get-attr el "rel") "canonical"))
              (do
                (remove-head-element "link[rel=\"canonical\"]")
                (dom-remove-child (dom-parent el) el)
                (dom-append-to-head el))
              :else (do
                (dom-remove-child (dom-parent el) el)
                (dom-append-to-head el)))))
        els))))

(define
  sx-mount
  :effects (mutation io)
  (fn
    (target (source :as string) (extra-env :as dict))
    (let
      ((el (resolve-mount-target target)))
      (when
        el
        (when
          (empty? (dom-child-list el))
          (let
            ((node (sx-render-with-env source extra-env)))
            (dom-set-text-content el "")
            (dom-append el node)
            (hoist-head-elements-full el)))
        (process-elements el)
        (sx-hydrate-elements el)
        (sx-hydrate-islands el)
        (run-post-render-hooks)))))

(define
  resolve-suspense
  :effects (mutation io)
  (fn
    ((id :as string) (sx :as string))
    (process-sx-scripts nil)
    (let
      ((el (dom-query (str "[data-suspense=\"" id "\"]"))))
      (if
        el
        (do
          (let
            ((exprs (parse sx)) (env (get-render-env nil)))
            (dom-set-text-content el "")
            (for-each
              (fn (expr) (dom-append el (render-to-dom expr env nil)))
              exprs)
            (process-elements el)
            (sx-hydrate-elements el)
            (sx-hydrate-islands el)
            (run-post-render-hooks)
            (dom-dispatch el "sx:resolved" {:id id})))
        (log-warn (str "resolveSuspense: no element for id=" id))))))

(define
  sx-hydrate-elements
  :effects (mutation io)
  (fn
    (root)
    (let
      ((els (dom-query-all (or root (dom-body)) "[data-sx]")))
      (for-each
        (fn
          (el)
          (when
            (not (is-processed? el "hydrated"))
            (mark-processed! el "hydrated")
            (sx-update-element el nil)))
        els))))

(define
  sx-update-element
  :effects (mutation io)
  (fn
    (el new-env)
    (let
      ((target (resolve-mount-target el)))
      (when
        target
        (let
          ((source (dom-get-attr target "data-sx")))
          (when
            source
            (let
              ((base-env (parse-env-attr target))
                (env (merge-envs base-env new-env)))
              (let
                ((node (sx-render-with-env source env)))
                (dom-set-text-content target "")
                (dom-append target node)
                (when new-env (store-env-attr target base-env new-env))))))))))

(define
  sx-render-component
  :effects (mutation io)
  (fn
    ((name :as string) (kwargs :as dict) (extra-env :as dict))
    (let
      ((full-name (if (starts-with? name "~") name (str "~" name))))
      (let
        ((env (get-render-env extra-env)) (comp (env-get env full-name)))
        (if
          (not (component? comp))
          (error (str "Unknown component: " full-name))
          (let
            ((call-expr (list (make-symbol full-name))))
            (for-each
              (fn
                ((k :as string))
                (append! call-expr (make-keyword (to-kebab k)))
                (append! call-expr (dict-get kwargs k)))
              (keys kwargs))
            (render-to-dom call-expr env nil)))))))

(define
  process-sx-scripts
  :effects (mutation io)
  (fn
    (root)
    (let
      ((scripts (query-sx-scripts root)))
      (for-each
        (fn
          (s)
          (when
            (not (is-processed? s "script"))
            (mark-processed! s "script")
            (let
              ((text (dom-text-content s)))
              (cond
                (dom-has-attr? s "data-components")
                (process-component-script s text)
                (or (nil? text) (empty? (trim text)))
                nil
                (dom-has-attr? s "data-init")
                (let
                  ((exprs (sx-parse text)))
                  (for-each (fn (expr) (cek-eval expr)) exprs))
                (dom-has-attr? s "data-mount")
                (let
                  ((mount-sel (dom-get-attr s "data-mount"))
                    (target (dom-query mount-sel)))
                  (when target (sx-mount target text nil)))
                :else (sx-load-components text)))))
        scripts))))

(define
  process-component-script
  :effects (mutation io)
  (fn
    (script (text :as string))
    (let
      ((hash (dom-get-attr script "data-hash")))
      (if
        (nil? hash)
        (when
          (and text (not (empty? (trim text))))
          (sx-load-components text))
        (let
          ((has-inline (and text (not (empty? (trim text))))))
          (let
            ((cached-hash (local-storage-get "sx-components-hash")))
            (if
              (= cached-hash hash)
              (if
                has-inline
                (do
                  (local-storage-set "sx-components-hash" hash)
                  (local-storage-set "sx-components-src" text)
                  (sx-load-components text)
                  (log-info "components: downloaded (cookie stale)"))
                (let
                  ((cached (local-storage-get "sx-components-src")))
                  (if
                    cached
                    (do
                      (sx-load-components cached)
                      (log-info (str "components: cached (" hash ")")))
                    (do (clear-sx-comp-cookie) (browser-reload)))))
              (if
                has-inline
                (do
                  (local-storage-set "sx-components-hash" hash)
                  (local-storage-set "sx-components-src" text)
                  (sx-load-components text)
                  (log-info (str "components: downloaded (" hash ")")))
                (do
                  (local-storage-remove "sx-components-hash")
                  (local-storage-remove "sx-components-src")
                  (clear-sx-comp-cookie)
                  (browser-reload)))))
          (set-sx-comp-cookie hash))))))

(define _page-routes (list))

(define
  process-page-scripts
  :effects (mutation io)
  (fn
    ()
    (let
      ((scripts (query-page-scripts)))
      (log-info (str "pages: found " (len scripts) " script tags"))
      (for-each
        (fn
          (s)
          (when
            (not (is-processed? s "pages"))
            (mark-processed! s "pages")
            (let
              ((text (dom-text-content s)))
              (log-info
                (str "pages: script text length=" (if text (len text) 0)))
              (if
                (and text (not (empty? (trim text))))
                (let
                  ((pages (parse text)))
                  (log-info (str "pages: parsed " (len pages) " entries"))
                  (for-each
                    (fn
                      ((page :as dict))
                      (append! _page-routes (merge page {:parsed (parse-route-pattern (get page "path"))})))
                    pages))
                (log-warn "pages: script tag is empty")))))
        scripts)
      (log-info (str "pages: " (len _page-routes) " routes loaded")))))

(define
  sx-hydrate-islands
  :effects (mutation io)
  (fn
    (root)
    (let
      ((els (dom-query-all (or root (dom-body)) "[data-sx-island]")))
      (preload-island-defs)
      (log-info
        (str
          "sx-hydrate-islands: "
          (len els)
          " island(s) in "
          (if root "subtree" "document")))
      (for-each
        (fn
          (el)
          (if
            (is-processed? el "island-hydrated")
            (log-info
              (str
                "  skip (already hydrated): "
                (dom-get-attr el "data-sx-island")))
            (do
              (log-info
                (str "  hydrating: " (dom-get-attr el "data-sx-island")))
              (mark-processed! el "island-hydrated")
              (hydrate-island el))))
        els))))

(define
  hydrate-island
  :effects (mutation io)
  (fn
    (el)
    (let
      ((name (dom-get-attr el "data-sx-island"))
        (state-sx (or (dom-get-attr el "data-sx-state") "{}")))
      (let
        ((comp-name (str "~" name)) (env (get-render-env nil)))
        (let
          ((comp (env-get (global-env) comp-name)))
          (if
            (not (or (component? comp) (island? comp)))
            (log-warn (str "hydrate-island: unknown island " comp-name))
            (let
              ((kwargs (or (first (sx-parse state-sx)) {}))
                (disposers (list))
                (local (env-merge (component-closure comp) env)))
              (for-each
                (fn
                  ((p :as string))
                  (env-bind!
                    local
                    p
                    (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
                (component-params comp))
              (let
                ((cursor (dict "parent" el "index" 0)))
                (host-call el "replaceChildren")
                (scope-push! "sx-hydrating" nil)
                (cek-try
                  (fn
                    ()
                    (with-island-scope
                      (fn (disposable) (append! disposers disposable))
                      (fn () (let ((body-dom (render-to-dom (component-body comp) local nil))) (when body-dom (dom-append el body-dom))))))
                  (fn
                    (err)
                    (scope-pop! "sx-hydrating")
                    (log-warn
                      (str "hydrate fallback: " comp-name " — " err))
                    (let
                      ((fallback (cek-try (fn () (with-island-scope (fn (d) (append! disposers d)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err2) (let ((e (dom-create-element "div" nil))) (dom-set-text-content e (str "Island error: " comp-name "\n" err2)) e)))))
                      (host-call el "replaceChildren" fallback)
                      nil)))
                (scope-pop! "sx-hydrating")
                (dom-set-data el "sx-disposers" disposers)
                (set-timeout (fn () (process-elements el)) 0)
                (log-info
                  (str
                    "hydrated island: ~"
                    comp-name
                    " ("
                    (len disposers)
                    " disposers)"))))))))))

(define
  dispose-island
  :effects (mutation io)
  (fn
    (el)
    (let
      ((disposers (dom-get-data el "sx-disposers")))
      (when
        disposers
        (for-each
          (fn ((d :as lambda)) (when (callable? d) (d)))
          disposers)
        (dom-set-data el "sx-disposers" nil)))
    (clear-processed! el "island-hydrated")))

(define
  dispose-islands-in
  :effects (mutation io)
  (fn
    (root)
    (when
      root
      (let
        ((islands (dom-query-all root "[data-sx-island]")))
        (when
          (and islands (not (empty? islands)))
          (let
            ((to-dispose (filter (fn (el) (not (is-processed? el "island-hydrated"))) islands)))
            (when
              (not (empty? to-dispose))
              (log-info (str "disposing " (len to-dispose) " island(s)"))
              (for-each dispose-island to-dispose))))))))

(define
  force-dispose-islands-in
  :effects (mutation io)
  (fn
    (root)
    (when
      root
      (let
        ((islands (dom-query-all root "[data-sx-island]")))
        (when
          (and islands (not (empty? islands)))
          (log-info (str "force-disposing " (len islands) " island(s)"))
          (for-each dispose-island islands))))))

(define *pre-render-hooks* (list))

(define *post-render-hooks* (list))

(define
  register-pre-render-hook
  :effects (mutation)
  (fn ((hook-fn :as lambda)) (append! *pre-render-hooks* hook-fn)))

(define
  register-post-render-hook
  :effects (mutation)
  (fn ((hook-fn :as lambda)) (append! *post-render-hooks* hook-fn)))

(define
  run-pre-render-hooks
  :effects (mutation io)
  (fn () (for-each (fn (hook) (cek-call hook nil)) *pre-render-hooks*)))

(define
  run-post-render-hooks
  :effects (mutation io)
  (fn
    ()
    (log-info
      (str "run-post-render-hooks: " (len *post-render-hooks*) " hooks"))
    (for-each
      (fn
        (hook)
        (log-info
          (str
            "  hook type: "
            (type-of hook)
            " callable: "
            (callable? hook)
            " lambda: "
            (lambda? hook)))
        (cek-call hook nil))
      *post-render-hooks*)
    (flush-collected-styles)))

(define
  boot-init
  :effects (mutation io)
  (fn
    ()
    (do
      (log-info (str "sx-browser " SX_VERSION))
      (process-page-scripts)
      (process-sx-scripts nil)
      (sx-hydrate-elements nil)
      (sx-hydrate-islands nil)
      (run-post-render-hooks)
      (flush-collected-styles)
      (set-timeout (fn () (process-elements nil)) 0)
      (dom-set-attr
        (host-get (dom-document) "documentElement")
        "data-sx-ready"
        "true")
      (dom-dispatch (dom-document) "sx:ready" nil)
      (log-info "sx:ready"))))
