giles
ede05c26f5
Core SX has zero IO — platforms extend __io-registry via (defio name :category :data/:code/:effect ...). The server web platform declares 44 operations in web/io.sx. batchable_helpers now derived from registry (:batchable true) instead of hardcoded list. Startup validation warns if bound IO ops lack registry entries. Browser gets empty registry, ready for step 5 (IO suspension). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
441 lines
13 KiB
Plaintext
441 lines
13 KiB
Plaintext
(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]")))
|
|
(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 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
|
|
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el)))))
|
|
(dom-set-text-content el "")
|
|
(dom-append el body-dom)
|
|
(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"))))
|