coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix callable? type mismatch, restore 20 HS test regressions, add host-* server stubs

Browse Source 
callable? in boot-helpers.sx checked for "native-fn" but type-of returns
"function" for NativeFn — broke make-spread and all native fn dispatch
in aser. Restore 20 behavioral tests replaced with NOT IMPLEMENTED stubs
by the test regeneration commit. Add host-* platform primitive stubs to
sx_server.ml so boot-helpers.sx loads without errors server-side.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-16 22:15:55 +00:00
parent 76f7e3b68a
commit 8c85e892c2
8 changed files with 2427 additions and 1975 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
hosts/ocaml/bin/sx_server.ml
View File

@@ -368,6 +368,9 @@ let cek_run_with_io state =
loop ()
(** IO-aware eval_expr — like eval_expr but handles IO suspension. *)
(* IO-aware eval — used by site_mode. The regular file loading path
uses Sx_ref.eval_expr which delegates IO suspension to the
_cek_io_suspend_hook → _vm_suspension_to_dict chain. *)
let _eval_expr_io expr env =
let state = Sx_ref.make_cek_state expr env (List []) in
cek_run_with_io state

360
shared/static/wasm/sx/boot-helpers.sx
View File

@@ -2,35 +2,105 @@
(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)
(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
(define _sx-bound-prefix "_sxBound")
(define
mark-processed!
(fn (el key) (host-set! el (str _sx-bound-prefix key) true)))
(define
(define
is-processed?
(fn
(el key)
(let ((v (host-get el (str _sx-bound-prefix key)))) (if v true false))))
(define
(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
(define
callable?
(fn
(v)
(let
((t (type-of v)))
(or (= t "lambda") (= t "native-fn") (= t "continuation")))))
(define
(or (= t "lambda") (= t "function") (= t "continuation")))))
(define
to-kebab
(fn
(s)
@@ -52,8 +122,7 @@
(append! result ch))
(loop (+ i 1)))))
(join "" result))))
(define
(define
sx-load-components
(fn
(text)
@@ -63,8 +132,7 @@
(let
((exprs (sx-parse text)))
(for-each (fn (expr) (cek-eval expr)) exprs)))))
(define
(define
call-expr
(fn
(expr-text env-bindings)
@@ -72,12 +140,10 @@
(let
((exprs (sx-parse expr-text)))
(when (not (empty? exprs)) (cek-eval (first exprs))))))
(define
(define
base-env
(fn () "Return the current global environment." (global-env)))
(define
(define
get-render-env
(fn
(extra)
@@ -85,15 +151,13 @@
(let
((env (base-env)))
(if (and extra (not (nil? extra))) (env-merge env extra) env))))
(define
(define
merge-envs
(fn
(a b)
"Merge two environments."
(if (and a b) (env-merge a b) (or a b (global-env)))))
(define
(define
sx-render-with-env
(fn
(source extra-env)
@@ -115,36 +179,32 @@
(host-call frag "appendChild" (host-get temp "content"))))))
exprs)
frag)))
(define
(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
(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
(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
(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
(fn
(label text err)
(log-error (str "Parse error in " label ": " err))))
(define
loaded-component-names
(fn
()
@@ -167,18 +227,15 @@
(split text ",")))))
scripts)
names)))
(define
(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
(define validate-for-request (fn (el) true))
(define
build-request-body
(fn
(el method url)
@@ -223,26 +280,16 @@
"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
(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)
@@ -257,8 +304,7 @@
(dom-remove-class indicator "hidden")
(dom-add-class indicator "sx-indicator-visible"))))
indicator-sel)))
(define
(define
disable-elements
(fn
(el)
@@ -271,8 +317,7 @@
(for-each (fn (e) (dom-set-attr e "disabled" "")) elts)
elts)
(list)))))
(define
(define
clear-loading-state
(fn
(el indicator disabled-elts)
@@ -289,14 +334,11 @@
(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
(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
(define
fetch-request
(fn
(config success-fn error-fn)
@@ -335,21 +377,29 @@
(fn (text) (success-fn ok status get-header text))
error-fn)))
error-fn))))))
(define
(define
fetch-location
(fn
(url)
(let
((target (or (dom-query "[sx-boost]") (dom-query "#main-panel"))))
(when target (browser-navigate url)))))
(define
(define
fetch-and-restore
(fn
(main url headers scroll-y)
(fetch-request
(dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil)
(dict
"url"
url
"method"
"GET"
"headers"
headers
"body"
nil
"signal"
nil)
(fn
(resp-ok status get-header text)
(when
@@ -360,7 +410,8 @@
(contains? ct "text/html")
(let
((parser (host-new "DOMParser"))
(doc (host-call parser "parseFromString" text "text/html"))
(doc
(host-call parser "parseFromString" text "text/html"))
(content (host-call doc "querySelector" "#sx-content")))
(if
content
@@ -402,37 +453,42 @@
(post-swap main)
(host-call (dom-window) "scrollTo" 0 scroll-y)))
(fn (err) (log-warn (str "fetch-and-restore error: " err))))))
(define
(define
fetch-preload
(fn
(url headers cache)
(fetch-request
(dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil)
(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
(define
fetch-streaming
(fn
(target pathname headers swap-fn)
(fetch-and-restore target pathname headers 0)))
(define
(define
dom-parse-html-document
(fn
(text)
(let
((parser (host-new "DOMParser")))
(host-call parser "parseFromString" text "text/html"))))
(define
(define
dom-body-inner-html
(fn (doc) (host-get (host-get doc "body") "innerHTML")))
(define
(define
create-script-clone
(fn
(dead)
@@ -456,8 +512,7 @@
(loop (+ i 1))))))
(host-set! live "textContent" (host-get dead "textContent"))
live)))
(define
(define
cross-origin?
(fn
(url)
@@ -465,24 +520,23 @@
(or (starts-with? url "http://") (starts-with? url "https://"))
(not (starts-with? url (browser-location-origin)))
false)))
(define
(define
browser-scroll-to
(fn (x y) (host-call (dom-window) "scrollTo" x y)))
(define
(define
with-transition
(fn
(enabled thunk)
(if
(and enabled (host-get (host-global "document") "startViewTransition"))
(and
enabled
(host-get (host-global "document") "startViewTransition"))
(host-call
(host-global "document")
"startViewTransition"
(host-callback thunk))
(thunk))))
(define
(define
event-source-connect
(fn
(url el)
@@ -490,8 +544,7 @@
((source (host-new "EventSource" url)))
(host-set! source "_sxElement" el)
source)))
(define
(define
event-source-listen
(fn
(source event-name handler)
@@ -500,8 +553,7 @@
"addEventListener"
event-name
(host-callback (fn (e) (handler e))))))
(define
(define
bind-boost-link
(fn
(el href)
@@ -520,8 +572,7 @@
(not (dom-has-attr? el "sx-push-url"))
(dom-set-attr el "sx-push-url" "true"))
(execute-request el nil nil))))))
(define
(define
bind-boost-form
(fn
(form method action)
@@ -529,8 +580,7 @@
form
"submit"
(fn (e) (prevent-default e) (execute-request form nil nil)))))
(define
(define
bind-client-route-click
(fn
(link href fallback-fn)
@@ -549,7 +599,10 @@
boost-el
(let
((attr (dom-get-attr boost-el "sx-boost")))
(if (and attr (not (= attr "true"))) attr "#sx-content"))
(if
(and attr (not (= attr "true")))
attr
"#sx-content"))
"#sx-content")))
(if
(try-client-route (url-pathname href) target-sel)
@@ -564,12 +617,9 @@
(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
(define sw-post-message (fn (msg) nil))
(define try-parse-json (fn (text) (json-parse text)))
(define
strip-component-scripts
(fn
(text)
@@ -596,17 +646,19 @@
(let
((comp-text (slice rest-str 0 end-offset))
(before (slice s 0 start-idx))
(after (slice rest-str (+ end-offset (len end-tag)))))
(after
(slice rest-str (+ end-offset (len end-tag)))))
(sx-load-components comp-text)
(loop (str before after)))))))))
result)))
(define
(define
extract-response-css
(fn
(text)
(let
((result text) (start-tag "<style data-sx-css>") (end-tag "</style>"))
((result text)
(start-tag "<style data-sx-css>")
(end-tag "</style>"))
(let
loop
((s result))
@@ -625,7 +677,8 @@
(let
((css-text (slice rest-str 0 end-offset))
(before (slice s 0 start-idx))
(after (slice rest-str (+ end-offset (len end-tag)))))
(after
(slice rest-str (+ end-offset (len end-tag)))))
(let
((doc (host-global "document"))
(style-el (host-call doc "createElement" "style")))
@@ -633,8 +686,7 @@
(dom-append-to-head style-el))
(loop (str before after)))))))))
result)))
(define
(define
sx-render
(fn
(text)
@@ -652,10 +704,10 @@
exprs)
(scope-pop! "sx-render-markers")
frag)))
(define sx-hydrate (fn (root) (sx-hydrate-elements (or root (dom-body)))))
(define
(define
sx-hydrate
(fn (root) (sx-hydrate-elements (or root (dom-body)))))
(define
sx-process-scripts
(fn
(root)
@@ -683,8 +735,7 @@
(log-error (str "sx-process-scripts: " err)))))
exprs))))))
scripts))))
(define
(define
select-from-container
(fn
(container selector)
@@ -697,8 +748,7 @@
(children-to-fragment selected)
(children-to-fragment container)))
(children-to-fragment container))))
(define
(define
children-to-fragment
(fn
(el)
@@ -712,8 +762,7 @@
((child (dom-first-child el)))
(when child (dom-append frag child) (loop))))
frag)))
(define
(define
select-html-from-doc
(fn
(doc selector)
@@ -723,12 +772,9 @@
((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
(define register-io-deps (fn (deps) nil))
(define resolve-page-data (fn (page-name params callback) nil))
(define
parse-sx-data
(fn
(text)
@@ -738,8 +784,7 @@
((exprs (sx-parse text)))
(if (not (empty? exprs)) (first exprs) nil))
nil)))
(define
(define
try-eval-content
(fn
(content-src env)
@@ -758,23 +803,14 @@
(when result (dom-append frag result))))
exprs)
frag)))))
(define
(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))
))
(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))

4
shared/static/wasm/sx/boot-helpers.sxbc
View File

File diff suppressed because one or more lines are too long

4
shared/static/wasm/sx/hs-compiler.sxbc
View File

File diff suppressed because one or more lines are too long

37
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-da652b03",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-def18509",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-875d5bae",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-def18509",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new

1250
spec/tests/test-hyperscript-behavioral.sx
View File

File diff suppressed because it is too large Load Diff

360
web/lib/boot-helpers.sx
View File

@@ -2,35 +2,105 @@
(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)
(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
(define _sx-bound-prefix "_sxBound")
(define
mark-processed!
(fn (el key) (host-set! el (str _sx-bound-prefix key) true)))
(define
(define
is-processed?
(fn
(el key)
(let ((v (host-get el (str _sx-bound-prefix key)))) (if v true false))))
(define
(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
(define
callable?
(fn
(v)
(let
((t (type-of v)))
(or (= t "lambda") (= t "native-fn") (= t "continuation")))))
(define
(or (= t "lambda") (= t "function") (= t "continuation")))))
(define
to-kebab
(fn
(s)
@@ -52,8 +122,7 @@
(append! result ch))
(loop (+ i 1)))))
(join "" result))))
(define
(define
sx-load-components
(fn
(text)
@@ -63,8 +132,7 @@
(let
((exprs (sx-parse text)))
(for-each (fn (expr) (cek-eval expr)) exprs)))))
(define
(define
call-expr
(fn
(expr-text env-bindings)
@@ -72,12 +140,10 @@
(let
((exprs (sx-parse expr-text)))
(when (not (empty? exprs)) (cek-eval (first exprs))))))
(define
(define
base-env
(fn () "Return the current global environment." (global-env)))
(define
(define
get-render-env
(fn
(extra)
@@ -85,15 +151,13 @@
(let
((env (base-env)))
(if (and extra (not (nil? extra))) (env-merge env extra) env))))
(define
(define
merge-envs
(fn
(a b)
"Merge two environments."
(if (and a b) (env-merge a b) (or a b (global-env)))))
(define
(define
sx-render-with-env
(fn
(source extra-env)
@@ -115,36 +179,32 @@
(host-call frag "appendChild" (host-get temp "content"))))))
exprs)
frag)))
(define
(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
(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
(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
(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
(fn
(label text err)
(log-error (str "Parse error in " label ": " err))))
(define
loaded-component-names
(fn
()
@@ -167,18 +227,15 @@
(split text ",")))))
scripts)
names)))
(define
(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
(define validate-for-request (fn (el) true))
(define
build-request-body
(fn
(el method url)
@@ -223,26 +280,16 @@
"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
(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)
@@ -257,8 +304,7 @@
(dom-remove-class indicator "hidden")
(dom-add-class indicator "sx-indicator-visible"))))
indicator-sel)))
(define
(define
disable-elements
(fn
(el)
@@ -271,8 +317,7 @@
(for-each (fn (e) (dom-set-attr e "disabled" "")) elts)
elts)
(list)))))
(define
(define
clear-loading-state
(fn
(el indicator disabled-elts)
@@ -289,14 +334,11 @@
(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
(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
(define
fetch-request
(fn
(config success-fn error-fn)
@@ -335,21 +377,29 @@
(fn (text) (success-fn ok status get-header text))
error-fn)))
error-fn))))))
(define
(define
fetch-location
(fn
(url)
(let
((target (or (dom-query "[sx-boost]") (dom-query "#main-panel"))))
(when target (browser-navigate url)))))
(define
(define
fetch-and-restore
(fn
(main url headers scroll-y)
(fetch-request
(dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil)
(dict
"url"
url
"method"
"GET"
"headers"
headers
"body"
nil
"signal"
nil)
(fn
(resp-ok status get-header text)
(when
@@ -360,7 +410,8 @@
(contains? ct "text/html")
(let
((parser (host-new "DOMParser"))
(doc (host-call parser "parseFromString" text "text/html"))
(doc
(host-call parser "parseFromString" text "text/html"))
(content (host-call doc "querySelector" "#sx-content")))
(if
content
@@ -402,37 +453,42 @@
(post-swap main)
(host-call (dom-window) "scrollTo" 0 scroll-y)))
(fn (err) (log-warn (str "fetch-and-restore error: " err))))))
(define
(define
fetch-preload
(fn
(url headers cache)
(fetch-request
(dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil)
(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
(define
fetch-streaming
(fn
(target pathname headers swap-fn)
(fetch-and-restore target pathname headers 0)))
(define
(define
dom-parse-html-document
(fn
(text)
(let
((parser (host-new "DOMParser")))
(host-call parser "parseFromString" text "text/html"))))
(define
(define
dom-body-inner-html
(fn (doc) (host-get (host-get doc "body") "innerHTML")))
(define
(define
create-script-clone
(fn
(dead)
@@ -456,8 +512,7 @@
(loop (+ i 1))))))
(host-set! live "textContent" (host-get dead "textContent"))
live)))
(define
(define
cross-origin?
(fn
(url)
@@ -465,24 +520,23 @@
(or (starts-with? url "http://") (starts-with? url "https://"))
(not (starts-with? url (browser-location-origin)))
false)))
(define
(define
browser-scroll-to
(fn (x y) (host-call (dom-window) "scrollTo" x y)))
(define
(define
with-transition
(fn
(enabled thunk)
(if
(and enabled (host-get (host-global "document") "startViewTransition"))
(and
enabled
(host-get (host-global "document") "startViewTransition"))
(host-call
(host-global "document")
"startViewTransition"
(host-callback thunk))
(thunk))))
(define
(define
event-source-connect
(fn
(url el)
@@ -490,8 +544,7 @@
((source (host-new "EventSource" url)))
(host-set! source "_sxElement" el)
source)))
(define
(define
event-source-listen
(fn
(source event-name handler)
@@ -500,8 +553,7 @@
"addEventListener"
event-name
(host-callback (fn (e) (handler e))))))
(define
(define
bind-boost-link
(fn
(el href)
@@ -520,8 +572,7 @@
(not (dom-has-attr? el "sx-push-url"))
(dom-set-attr el "sx-push-url" "true"))
(execute-request el nil nil))))))
(define
(define
bind-boost-form
(fn
(form method action)
@@ -529,8 +580,7 @@
form
"submit"
(fn (e) (prevent-default e) (execute-request form nil nil)))))
(define
(define
bind-client-route-click
(fn
(link href fallback-fn)
@@ -549,7 +599,10 @@
boost-el
(let
((attr (dom-get-attr boost-el "sx-boost")))
(if (and attr (not (= attr "true"))) attr "#sx-content"))
(if
(and attr (not (= attr "true")))
attr
"#sx-content"))
"#sx-content")))
(if
(try-client-route (url-pathname href) target-sel)
@@ -564,12 +617,9 @@
(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
(define sw-post-message (fn (msg) nil))
(define try-parse-json (fn (text) (json-parse text)))
(define
strip-component-scripts
(fn
(text)
@@ -596,17 +646,19 @@
(let
((comp-text (slice rest-str 0 end-offset))
(before (slice s 0 start-idx))
(after (slice rest-str (+ end-offset (len end-tag)))))
(after
(slice rest-str (+ end-offset (len end-tag)))))
(sx-load-components comp-text)
(loop (str before after)))))))))
result)))
(define
(define
extract-response-css
(fn
(text)
(let
((result text) (start-tag "<style data-sx-css>") (end-tag "</style>"))
((result text)
(start-tag "<style data-sx-css>")
(end-tag "</style>"))
(let
loop
((s result))
@@ -625,7 +677,8 @@
(let
((css-text (slice rest-str 0 end-offset))
(before (slice s 0 start-idx))
(after (slice rest-str (+ end-offset (len end-tag)))))
(after
(slice rest-str (+ end-offset (len end-tag)))))
(let
((doc (host-global "document"))
(style-el (host-call doc "createElement" "style")))
@@ -633,8 +686,7 @@
(dom-append-to-head style-el))
(loop (str before after)))))))))
result)))
(define
(define
sx-render
(fn
(text)
@@ -652,10 +704,10 @@
exprs)
(scope-pop! "sx-render-markers")
frag)))
(define sx-hydrate (fn (root) (sx-hydrate-elements (or root (dom-body)))))
(define
(define
sx-hydrate
(fn (root) (sx-hydrate-elements (or root (dom-body)))))
(define
sx-process-scripts
(fn
(root)
@@ -683,8 +735,7 @@
(log-error (str "sx-process-scripts: " err)))))
exprs))))))
scripts))))
(define
(define
select-from-container
(fn
(container selector)
@@ -697,8 +748,7 @@
(children-to-fragment selected)
(children-to-fragment container)))
(children-to-fragment container))))
(define
(define
children-to-fragment
(fn
(el)
@@ -712,8 +762,7 @@
((child (dom-first-child el)))
(when child (dom-append frag child) (loop))))
frag)))
(define
(define
select-html-from-doc
(fn
(doc selector)
@@ -723,12 +772,9 @@
((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
(define register-io-deps (fn (deps) nil))
(define resolve-page-data (fn (page-name params callback) nil))
(define
parse-sx-data
(fn
(text)
@@ -738,8 +784,7 @@
((exprs (sx-parse text)))
(if (not (empty? exprs)) (first exprs) nil))
nil)))
(define
(define
try-eval-content
(fn
(content-src env)
@@ -758,23 +803,14 @@
(when result (dom-append frag result))))
exprs)
frag)))))
(define
(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))
))
(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))