Inline test runner: 5/5 temperature converter tests passing
Fixed three fundamental issues: 1. cek-try arg passing: handler was called with raw string instead of (List [String msg]), causing "lambda expects 1 args, got N" errors 2. Silent island hydration failures: hydrate-island now wraps body render in cek-try, displaying red error box with stack trace instead of empty div. No more silent failures. 3. swap! thunk leak: apply result wasn't trampolined, storing thunks as signal values instead of evaluated results Also fixed: assert= uses = instead of equal? for value comparison, assert-signal-value uses deref instead of signal-value, HTML entity decoding in script tag test source via host-call replaceAll. Temperature converter demo page now shows live test results: ✓ initial celsius is 20 ✓ computed fahrenheit = celsius * 1.8 + 32 ✓ +5 increments celsius ✓ fahrenheit updates on celsius change ✓ multiple clicks accumulate 1116/1116 OCaml tests pass. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,575 +1,45 @@
|
||||
;; ==========================================================================
|
||||
;; boot.sx — Browser boot, mount, hydrate, script processing
|
||||
;;
|
||||
;; Handles the browser startup lifecycle:
|
||||
;; 1. CSS tracking init
|
||||
;; 2. Component script processing (from <script type="text/sx">)
|
||||
;; 3. Hydration of [data-sx] elements
|
||||
;; 4. Engine element processing
|
||||
;;
|
||||
;; Also provides the public mounting/hydration API:
|
||||
;; mount, hydrate, update, render-component
|
||||
;;
|
||||
;; Depends on:
|
||||
;; orchestration.sx — process-elements, engine-init
|
||||
;; adapter-dom.sx — render-to-dom
|
||||
;; render.sx — shared registries
|
||||
;; ==========================================================================
|
||||
(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))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Head element hoisting (full version)
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Moves <meta>, <title>, <link rel=canonical>, <script type=application/ld+json>
|
||||
;; from rendered content to <head>, deduplicating as needed.
|
||||
(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 HEAD_HOIST_SELECTOR
|
||||
"meta, title, link[rel='canonical'], script[type='application/ld+json']")
|
||||
(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 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
|
||||
;; <title> — replace document title
|
||||
(= tag "title")
|
||||
(do
|
||||
(set-document-title (dom-text-content el))
|
||||
(dom-remove-child (dom-parent el) el))
|
||||
(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))))
|
||||
|
||||
;; <meta> — deduplicate by name or property
|
||||
(= 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))
|
||||
(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))))))))))
|
||||
|
||||
;; <link rel=canonical> — deduplicate
|
||||
(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))
|
||||
(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)))))))
|
||||
|
||||
;; Everything else (ld+json, etc.) — just move
|
||||
:else
|
||||
(do
|
||||
(dom-remove-child (dom-parent el) el)
|
||||
(dom-append-to-head el)))))
|
||||
els))))
|
||||
(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) (eval-expr expr (env-extend (dict)))) 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))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Mount — render SX source into a DOM element
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-mount :effects [mutation io]
|
||||
(fn (target (source :as string) (extra-env :as dict))
|
||||
;; Render SX source string into target element.
|
||||
;; target: Element or CSS selector string
|
||||
;; source: SX source string
|
||||
;; extra-env: optional extra bindings dict
|
||||
(let ((el (resolve-mount-target target)))
|
||||
(when el
|
||||
;; If the server already rendered content (isomorphic SSR),
|
||||
;; skip re-render — just hydrate the existing DOM.
|
||||
(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 from rendered content
|
||||
(hoist-head-elements-full el)))
|
||||
;; Process sx- attributes, hydrate data-sx and islands
|
||||
(process-elements el)
|
||||
(sx-hydrate-elements el)
|
||||
(sx-hydrate-islands el)
|
||||
(run-post-render-hooks)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Resolve Suspense — replace streaming placeholder with resolved content
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Called by inline <script> tags that arrive during chunked transfer:
|
||||
;; __sxResolve("content", "(~article :title \"Hello\")")
|
||||
;;
|
||||
;; Finds the suspense wrapper by data-suspense attribute, renders the
|
||||
;; new SX content, and replaces the wrapper's children.
|
||||
|
||||
(define resolve-suspense :effects [mutation io]
|
||||
(fn ((id :as string) (sx :as string))
|
||||
;; Process any new <script type="text/sx"> tags that arrived via
|
||||
;; streaming (e.g. extra component defs) before resolving.
|
||||
(process-sx-scripts nil)
|
||||
(let ((el (dom-query (str "[data-suspense=\"" id "\"]"))))
|
||||
(if el
|
||||
(do
|
||||
;; parse returns a list of expressions — render each individually
|
||||
;; (mirroring the public render() API).
|
||||
(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))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Hydrate — render all [data-sx] elements
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-hydrate-elements :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Find all [data-sx] elements within root and render them.
|
||||
(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))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Update — re-render a [data-sx] element with new env data
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-update-element :effects [mutation io]
|
||||
(fn (el new-env)
|
||||
;; Re-render a [data-sx] element.
|
||||
;; Reads source from data-sx attr, base env from data-sx-env attr.
|
||||
(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)
|
||||
;; Update stored env if new-env provided
|
||||
(when new-env
|
||||
(store-env-attr target base-env new-env))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Render component — build synthetic call from kwargs dict
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-render-component :effects [mutation io]
|
||||
(fn ((name :as string) (kwargs :as dict) (extra-env :as dict))
|
||||
;; Render a named component with keyword args.
|
||||
;; name: component name (with or without ~ prefix)
|
||||
;; kwargs: dict of param-name → value
|
||||
;; extra-env: optional extra env bindings
|
||||
(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))
|
||||
;; Build synthetic call expression
|
||||
(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)))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Script processing — <script type="text/sx">
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-sx-scripts :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Process all <script type="text/sx"> tags.
|
||||
;; - data-components + data-hash → localStorage cache
|
||||
;; - data-mount="<selector>" → render into target
|
||||
;; - Default: load as components
|
||||
(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
|
||||
;; Component definitions
|
||||
(dom-has-attr? s "data-components")
|
||||
(process-component-script s text)
|
||||
|
||||
;; Empty script — skip
|
||||
(or (nil? text) (empty? (trim text)))
|
||||
nil
|
||||
|
||||
;; Init scripts — evaluate SX for side effects (event listeners etc.)
|
||||
(dom-has-attr? s "data-init")
|
||||
(let ((exprs (sx-parse text)))
|
||||
(for-each
|
||||
(fn (expr) (eval-expr expr (env-extend (dict))))
|
||||
exprs))
|
||||
|
||||
;; Mount directive
|
||||
(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)))
|
||||
|
||||
;; Default: load as components
|
||||
:else
|
||||
(sx-load-components text)))))
|
||||
scripts))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Component script with caching
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-component-script :effects [mutation io]
|
||||
(fn (script (text :as string))
|
||||
;; Handle <script type="text/sx" data-components data-hash="...">
|
||||
(let ((hash (dom-get-attr script "data-hash")))
|
||||
(if (nil? hash)
|
||||
;; Legacy: no hash — just load inline
|
||||
(when (and text (not (empty? (trim text))))
|
||||
(sx-load-components text))
|
||||
;; Hash-based caching
|
||||
(let ((has-inline (and text (not (empty? (trim text))))))
|
||||
(let ((cached-hash (local-storage-get "sx-components-hash")))
|
||||
(if (= cached-hash hash)
|
||||
;; Cache hit
|
||||
(if has-inline
|
||||
;; Server sent full source (cookie stale) — update cache
|
||||
(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)"))
|
||||
;; Server omitted source — load from cache
|
||||
(let ((cached (local-storage-get "sx-components-src")))
|
||||
(if cached
|
||||
(do
|
||||
(sx-load-components cached)
|
||||
(log-info (str "components: cached (" hash ")")))
|
||||
;; Cache entry missing — clear cookie and reload
|
||||
(do
|
||||
(clear-sx-comp-cookie)
|
||||
(browser-reload)))))
|
||||
;; Cache miss — hash mismatch
|
||||
(if has-inline
|
||||
;; Server sent full source — cache it
|
||||
(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 ")")))
|
||||
;; Server omitted but cache stale — clear and reload
|
||||
(do
|
||||
(local-storage-remove "sx-components-hash")
|
||||
(local-storage-remove "sx-components-src")
|
||||
(clear-sx-comp-cookie)
|
||||
(browser-reload)))))
|
||||
(set-sx-comp-cookie hash))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Page registry for client-side routing
|
||||
;; --------------------------------------------------------------------------
|
||||
(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 ()
|
||||
;; Process <script type="text/sx-pages"> tags.
|
||||
;; Parses SX page registry and builds route entries with parsed patterns.
|
||||
(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 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))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Island hydration — activate reactive islands from SSR output
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; The server renders islands as:
|
||||
;; <div data-sx-island="counter" data-sx-state='{"initial": 0}'>
|
||||
;; ...static HTML...
|
||||
;; </div>
|
||||
;;
|
||||
;; Hydration:
|
||||
;; 1. Find all [data-sx-island] elements
|
||||
;; 2. Look up the island component by name
|
||||
;; 3. Parse data-sx-state into kwargs
|
||||
;; 4. Re-render the island body in a reactive context
|
||||
;; 5. Morph existing DOM to preserve structure, focus, scroll
|
||||
;; 6. Store disposers on the element for cleanup
|
||||
(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) (process-elements el) (log-info (str "hydrated island: " comp-name " (" (len disposers) " disposers)"))))))))))
|
||||
|
||||
(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 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 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))
|
||||
(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))))))))
|
||||
|
||||
;; Parse state and build keyword args — SX format, not JSON
|
||||
(let ((kwargs (or (first (sx-parse state-sx)) {}))
|
||||
(disposers (list))
|
||||
(local (env-merge (component-closure comp) env)))
|
||||
|
||||
;; Bind params from kwargs
|
||||
(for-each
|
||||
(fn ((p :as string))
|
||||
(env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
||||
(component-params comp))
|
||||
|
||||
;; Render the island body in a reactive scope
|
||||
(let ((body-dom
|
||||
(with-island-scope
|
||||
(fn (disposable) (append! disposers disposable))
|
||||
(fn () (render-to-dom (component-body comp) local nil)))))
|
||||
|
||||
;; Clear existing content and append reactive DOM directly.
|
||||
;; Unlike morph-children, this preserves addEventListener-based
|
||||
;; event handlers on the freshly rendered nodes.
|
||||
(dom-set-text-content el "")
|
||||
(dom-append el body-dom)
|
||||
|
||||
;; Store disposers for cleanup
|
||||
(dom-set-data el "sx-disposers" disposers)
|
||||
|
||||
;; Process any sx- attributes on new content
|
||||
(process-elements el)
|
||||
|
||||
(log-info (str "hydrated island: " comp-name
|
||||
" (" (len disposers) " disposers)"))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Island disposal — clean up when island removed from DOM
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(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 hydration marker so the island can be re-hydrated
|
||||
(clear-processed! el "island-hydrated")))
|
||||
|
||||
(define dispose-islands-in :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Dispose islands within root, but SKIP hydrated islands —
|
||||
;; they may be preserved across morphs. Only dispose islands
|
||||
;; that are not currently hydrated (e.g. freshly parsed content
|
||||
;; being discarded) or that have been explicitly detached.
|
||||
(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)
|
||||
;; Dispose ALL islands in root, including hydrated ones.
|
||||
;; Used when the target is being completely replaced (outerHTML swap).
|
||||
(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))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Render hooks — generic pre/post callbacks for hydration, swap, mount.
|
||||
;; The spec calls these at render boundaries; the app decides what to do.
|
||||
;; Pre-render: setup before DOM changes (e.g. prepare state).
|
||||
;; Post-render: cleanup after DOM changes (e.g. flush collected CSS).
|
||||
;; --------------------------------------------------------------------------
|
||||
(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-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 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-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*)))
|
||||
(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*)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Full boot sequence
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define boot-init :effects [mutation io]
|
||||
(fn ()
|
||||
;; Full browser initialization:
|
||||
;; 1. CSS tracking
|
||||
;; 2. Style dictionary
|
||||
;; 3. Process scripts (components + mounts)
|
||||
;; 4. Process page registry (client-side routing)
|
||||
;; 5. Hydrate [data-sx] elements
|
||||
;; 6. Hydrate [data-sx-island] elements (reactive islands)
|
||||
;; 7. Process engine elements
|
||||
(do
|
||||
(log-info (str "sx-browser " SX_VERSION))
|
||||
(init-css-tracking)
|
||||
(process-page-scripts)
|
||||
(process-sx-scripts nil)
|
||||
(sx-hydrate-elements nil)
|
||||
(sx-hydrate-islands nil)
|
||||
(run-post-render-hooks)
|
||||
(process-elements nil)
|
||||
;; Wire up popstate for back/forward navigation
|
||||
(dom-listen (dom-window) "popstate"
|
||||
(fn (e) (handle-popstate 0))))))
|
||||
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Platform interface — Boot
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; From orchestration.sx:
|
||||
;; process-elements, init-css-tracking
|
||||
;;
|
||||
;; === DOM / Render ===
|
||||
;; (resolve-mount-target target) → Element (string → querySelector, else identity)
|
||||
;; (sx-render-with-env source extra-env) → DOM node (parse + render with componentEnv + extra)
|
||||
;; (get-render-env extra-env) → merged component env + extra
|
||||
;; (merge-envs base new) → merged env dict
|
||||
;; (render-to-dom expr env ns) → DOM node
|
||||
;; (sx-load-components text) → void (parse + eval into componentEnv)
|
||||
;;
|
||||
;; === DOM queries ===
|
||||
;; (dom-query sel) → Element or nil
|
||||
;; (dom-query-all root sel) → list of Elements
|
||||
;; (dom-body) → document.body
|
||||
;; (dom-get-attr el name) → string or nil
|
||||
;; (dom-has-attr? el name) → boolean
|
||||
;; (dom-text-content el) → string
|
||||
;; (dom-set-text-content el s) → void
|
||||
;; (dom-append el child) → void
|
||||
;; (dom-remove-child parent el) → void
|
||||
;; (dom-parent el) → Element
|
||||
;; (dom-append-to-head el) → void
|
||||
;; (dom-tag-name el) → string
|
||||
;;
|
||||
;; === Head hoisting ===
|
||||
;; (set-document-title s) → void (document.title = s)
|
||||
;; (remove-head-element sel) → void (remove matching element from <head>)
|
||||
;;
|
||||
;; === Script queries ===
|
||||
;; (query-sx-scripts root) → list of <script type="text/sx"> elements
|
||||
;; (query-page-scripts) → list of <script type="text/sx-pages"> elements
|
||||
;;
|
||||
;; === localStorage ===
|
||||
;; (local-storage-get key) → string or nil
|
||||
;; (local-storage-set key val) → void
|
||||
;; (local-storage-remove key) → void
|
||||
;;
|
||||
;; === Cookies ===
|
||||
;; (set-sx-comp-cookie hash) → void
|
||||
;; (clear-sx-comp-cookie) → void
|
||||
;;
|
||||
;; === Env ===
|
||||
;; (parse-env-attr el) → dict (parse data-sx-env JSON attr)
|
||||
;; (store-env-attr el base new) → void (merge and store back as JSON)
|
||||
;; (to-kebab s) → string (underscore → kebab-case)
|
||||
;;
|
||||
;; === Logging ===
|
||||
;; (log-info msg) → void (console.log with prefix)
|
||||
;; (log-parse-error label text err) → void (diagnostic parse error)
|
||||
;;
|
||||
;; === Parsing (island state) ===
|
||||
;; (sx-parse str) → list of AST expressions (from parser.sx)
|
||||
;;
|
||||
;; === Processing markers ===
|
||||
;; (mark-processed! el key) → void
|
||||
;; (is-processed? el key) → boolean
|
||||
;;
|
||||
;; === Morph ===
|
||||
;; (morph-children target source) → void (morph target's children to match source)
|
||||
;;
|
||||
;; === Island support (from adapter-dom.sx / signals.sx) ===
|
||||
;; (island? x) → boolean
|
||||
;; (component-closure comp) → env
|
||||
;; (component-params comp) → list of param names
|
||||
;; (component-body comp) → AST
|
||||
;; (component-name comp) → string
|
||||
;; (component-has-children? comp) → boolean
|
||||
;; (with-island-scope scope-fn body-fn) → result (track disposables)
|
||||
;; (render-to-dom expr env ns) → DOM node
|
||||
;; (dom-get-data el key) → any (from el._sxData)
|
||||
;; (dom-set-data el key val) → void
|
||||
;; --------------------------------------------------------------------------
|
||||
(define boot-init :effects (mutation io) (fn () (do (log-info (str "sx-browser " SX_VERSION)) (init-css-tracking) (process-page-scripts) (process-sx-scripts nil) (sx-hydrate-elements nil) (sx-hydrate-islands nil) (run-post-render-hooks) (process-elements nil) (dom-listen (dom-window) "popstate" (fn (e) (handle-popstate 0))))))
|
||||
|
||||
Reference in New Issue
Block a user