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

Step 16: Fix client routing — prefix-agnostic SX URL matching

Browse Source 
The /sx/ prefix mismatch: defpage declares paths like /language/docs/<slug>
but browser URLs are /sx/(language.(doc.slug)). find-matching-route used
starts-with? "/(", missing the /sx/ prefix entirely.

Fix: find-matching-route now uses (index-of path "/(") to detect the SX
URL portion regardless of prefix. Works for /sx/, /myapp/, any prefix.
No hardcoded paths.

Also fixed deps-satisfied?: nil deps (unknown) now returns false instead
of true, preventing client-side eval of pages with unresolved components.
Correctly falls back to server fetch.

Verified with Playwright: clicking "Getting Started" on the docs page now
shows "sx:route deps miss for docs-page" → "sx:route server fetch" instead
of the old "sx:route no match (51 routes)".

2 new router tests for prefix stripping. 2914/2914 total, zero failures.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-05 21:18:14 +00:00
parent 5d88b363e4
commit 9552750c4f
10 changed files with 18011 additions and 7661 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
shared/static/wasm/sx/deps.sxbc
View File

File diff suppressed because one or more lines are too long

165
shared/static/wasm/sx/orchestration.sx
View File

@@ -6,7 +6,8 @@
(import (web adapter-dom))
(import (web engine))
(define-library (web orchestration)
(define-library
(web orchestration)
(export
_preload-cache
dispatch-trigger-events
@@ -68,9 +69,7 @@
handle-popstate
engine-init)
(begin
(define _preload-cache (dict))
(define
dispatch-trigger-events
:effects (mutation io)
@@ -83,7 +82,9 @@
(if
parsed
(for-each
(fn ((key :as string)) (dom-dispatch el key (get parsed key)))
(fn
((key :as string))
(dom-dispatch el key (get parsed key)))
(keys parsed))
(for-each
(fn
@@ -94,7 +95,6 @@
(not (empty? trimmed))
(dom-dispatch el trimmed (dict)))))
(split header-val ",")))))))
(define
execute-request
:effects (mutation io)
@@ -142,7 +142,6 @@
"SX-Prompt"
prompt-val)
extraParams))))))))))))
(define
do-fetch
:effects (mutation io)
@@ -254,9 +253,14 @@
(when
(not (abort-error? err))
(log-warn
(str "sx:fetch error " method " " final-url " — " err))
(str
"sx:fetch error "
method
" "
final-url
" — "
err))
(dom-dispatch el "sx:requestError" (dict "error" err))))))))))))
(define
handle-fetch-success
:effects (mutation io)
@@ -282,15 +286,27 @@
((target-el (if (get resp-headers "retarget") (dom-query (get resp-headers "retarget")) (resolve-target el)))
(swap-spec
(parse-swap-spec
(or (get resp-headers "reswap") (dom-get-attr el "sx-swap"))
(or
(get resp-headers "reswap")
(dom-get-attr el "sx-swap"))
(dom-has-class? (dom-body) "sx-transitions")))
(swap-style (get swap-spec "style"))
(use-transition (get swap-spec "transition"))
(ct (or (get resp-headers "content-type") "")))
(if
(contains? ct "text/sx")
(handle-sx-response el target-el text swap-style use-transition)
(handle-html-response el target-el text swap-style use-transition))
(handle-sx-response
el
target-el
text
swap-style
use-transition)
(handle-html-response
el
target-el
text
swap-style
use-transition))
(dispatch-trigger-events el (get resp-headers "trigger-swap"))
(handle-history el url resp-headers)
(set-timeout
@@ -307,7 +323,6 @@
el
"sx:afterSwap"
(dict "target" target-el "swap" swap-style)))))))
(define
flush-collected-styles
:effects (mutation io)
@@ -323,7 +338,6 @@
(dom-set-attr el "data-sx-css" "true")
(dom-set-prop el "textContent" (join "" rules))
(dom-append-to-head el))))))
(define
handle-sx-response
:effects (mutation io)
@@ -372,7 +386,6 @@
(= swap-style "outerHTML")
(dom-parent (or swap-result target))
(or swap-result target)))))))))))))))
(define
handle-html-response
:effects (mutation io)
@@ -437,7 +450,6 @@
(children-to-fragment container)
swap-style)
(post-swap target))))))))))
(define
handle-retry
:effects (mutation io)
@@ -463,7 +475,6 @@
(set-timeout
(fn () (do-fetch el verb method url extraParams))
ms)))))))
(define
bind-triggers
:effects (mutation io)
@@ -512,7 +523,6 @@
(= kind "event")
(bind-event el (get trigger "event") mods verbInfo))))
triggers))))
(define
bind-event
:effects (mutation io)
@@ -554,11 +564,14 @@
(when
(and
should-fire
(not (and (= event-name "click") (event-modifier-key? e))))
(not
(and (= event-name "click") (event-modifier-key? e))))
(when
(or
(= event-name "submit")
(and (= event-name "click") (dom-has-attr? el "href")))
(and
(= event-name "click")
(dom-has-attr? el "href")))
(prevent-default e))
(let
((live-info (get-verb-info el))
@@ -586,7 +599,9 @@
(when
is-get-link
(log-info
(str "sx:route server fetch " (get live-info "url"))))
(str
"sx:route server fetch "
(get live-info "url"))))
(if
(get mods "delay")
(do
@@ -598,13 +613,13 @@
(get mods "delay"))))
(execute-request el nil nil))))))))
(if (get mods "once") (dict "once" true) nil))))))
(define
post-swap
:effects (mutation io)
(fn
(root)
(log-info (str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(log-info
(str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(activate-scripts root)
(sx-process-scripts root)
(sx-hydrate root)
@@ -612,7 +627,6 @@
(run-post-render-hooks)
(flush-collected-styles)
(process-elements root)))
(define
process-settle-hooks
:effects (mutation io)
@@ -625,7 +639,6 @@
(let
((exprs (sx-parse settle-expr)))
(for-each (fn (expr) (cek-eval expr)) exprs))))))
(define
activate-scripts
:effects (mutation io)
@@ -647,7 +660,6 @@
(dom-set-attr live "data-sx-activated" "true")
(dom-replace-child (dom-parent dead) live dead))))
scripts)))))
(define
process-oob-swaps
:effects (mutation io)
@@ -668,7 +680,6 @@
(dom-remove-child (dom-parent oob-el) oob-el))
(when target (swap-fn target oob-el swap-type))))
oobs))))
(define
hoist-head-elements
:effects (mutation io)
@@ -685,10 +696,11 @@
(for-each
(fn
(link)
(when (dom-parent link) (dom-remove-child (dom-parent link) link))
(when
(dom-parent link)
(dom-remove-child (dom-parent link) link))
(dom-append-to-head link))
(dom-query-all container "link[rel=\"stylesheet\"]"))))
(define
process-boosted
:effects (mutation io)
@@ -697,7 +709,6 @@
(for-each
(fn (container) (boost-descendants container))
(dom-query-all (or root (dom-body)) "[sx-boost]"))))
(define
boost-descendants
:effects (mutation io)
@@ -738,7 +749,9 @@
(let
((method (upper (or (dom-get-attr form "method") "GET")))
(action
(or (dom-get-attr form "action") (browser-location-href))))
(or
(dom-get-attr form "action")
(browser-location-href))))
(when
(and
(not (dom-has-attr? form "sx-target"))
@@ -750,11 +763,8 @@
(dom-set-attr form "sx-swap" "innerHTML"))
(bind-boost-form form method action))))
(dom-query-all container "form")))))
(define _page-data-cache (dict))
(define _page-data-cache-ttl 30000)
(define
page-data-cache-key
:effects ()
@@ -773,7 +783,6 @@
(append! parts (str k "=" (get params k))))
(keys params))
(str base ":" (join "&" parts)))))))
(define
page-data-cache-get
:effects (mutation io)
@@ -788,14 +797,12 @@
(> (- (now-ms) (get entry "ts")) _page-data-cache-ttl)
(do (dict-set! _page-data-cache cache-key nil) nil)
(get entry "data"))))))
(define
page-data-cache-set
:effects (mutation io)
(fn
((cache-key :as string) data)
(dict-set! _page-data-cache cache-key {:data data :ts (now-ms)})))
(define
invalidate-page-cache
:effects (mutation io)
@@ -810,7 +817,6 @@
(keys _page-data-cache))
(sw-post-message {:type "invalidate" :page page-name})
(log-info (str "sx:cache invalidate " page-name))))
(define
invalidate-all-page-cache
:effects (mutation io)
@@ -819,7 +825,6 @@
(set! _page-data-cache (dict))
(sw-post-message {:type "invalidate" :page "*"})
(log-info "sx:cache invalidate *")))
(define
update-page-cache
:effects (mutation io)
@@ -829,7 +834,6 @@
((cache-key (page-data-cache-key page-name (dict))))
(page-data-cache-set cache-key data)
(log-info (str "sx:cache update " page-name)))))
(define
process-cache-directives
:effects (mutation io)
@@ -858,9 +862,7 @@
(let
((data (parse-sx-data response-text)))
(when data (update-page-cache hdr-update data)))))))
(define _optimistic-snapshots (dict))
(define
optimistic-cache-update
:effects (mutation)
@@ -875,7 +877,6 @@
(dict-set! _optimistic-snapshots cache-key cached)
(page-data-cache-set cache-key predicted)
predicted)))))
(define
optimistic-cache-revert
:effects (mutation)
@@ -888,14 +889,12 @@
(page-data-cache-set cache-key snapshot)
(dict-delete! _optimistic-snapshots cache-key)
snapshot))))
(define
optimistic-cache-confirm
:effects (mutation)
(fn
((cache-key :as string))
(dict-delete! _optimistic-snapshots cache-key)))
(define
submit-mutation
:effects (mutation io)
@@ -925,20 +924,16 @@
(let
((reverted (optimistic-cache-revert cache-key)))
(when reverted (try-rerender-page page-name params reverted))
(log-warn (str "sx:optimistic reverted " page-name ": " error))
(log-warn
(str "sx:optimistic reverted " page-name ": " error))
(when on-complete (on-complete "reverted"))))))))
(define _is-online true)
(define _offline-queue (list))
(define offline-is-online? :effects (io) (fn () _is-online))
(define
offline-set-online!
:effects (mutation)
(fn ((val :as boolean)) (set! _is-online val)))
(define
offline-queue-mutation
:effects (mutation io)
@@ -976,7 +971,6 @@
(len _offline-queue)
" pending)"))
entry)))
(define
offline-sync
:effects (mutation io)
@@ -996,7 +990,8 @@
(fn
(result)
(dict-set! entry "status" "synced")
(log-info (str "sx:offline synced " (get entry "action"))))
(log-info
(str "sx:offline synced " (get entry "action"))))
(fn
((error :as string))
(dict-set! entry "status" "failed")
@@ -1007,7 +1002,6 @@
": "
error)))))
pending)))))
(define
offline-pending-count
:effects (io)
@@ -1017,7 +1011,6 @@
(filter
(fn ((e :as dict)) (= (get e "status") "pending"))
_offline-queue))))
(define
offline-aware-mutation
:effects (mutation io)
@@ -1045,7 +1038,6 @@
params
mutator-fn)
(when on-complete (on-complete "queued"))))))
(define
current-page-layout
:effects (io)
@@ -1055,7 +1047,6 @@
((pathname (url-pathname (browser-location-href)))
(match (find-matching-route pathname _page-routes)))
(if (nil? match) "" (or (get match "layout") "")))))
(define
swap-rendered-content
:effects (mutation io)
@@ -1088,9 +1079,11 @@
(sx-hydrate-elements target)
(sx-hydrate-islands target)
(run-post-render-hooks)
(dom-dispatch target "sx:clientRoute" (dict "pathname" pathname))
(dom-dispatch
target
"sx:clientRoute"
(dict "pathname" pathname))
(log-info (str "sx:route client " pathname))))))))
(define
resolve-route-target
:effects (io)
@@ -1100,7 +1093,6 @@
(and target-sel (not (= target-sel "true")))
(dom-query target-sel)
nil)))
(define
deps-satisfied?
:effects (io)
@@ -1109,10 +1101,12 @@
(let
((deps (get match "deps")) (loaded (loaded-component-names)))
(if
(or (nil? deps) (empty? deps))
(nil? deps)
false
(if
(empty? deps)
true
(every? (fn ((dep :as string)) (contains? loaded dep)) deps)))))
(every? (fn ((dep :as string)) (contains? loaded dep)) deps))))))
(define
try-client-route
:effects (mutation io)
@@ -1166,7 +1160,8 @@
(if
(not (deps-satisfied? match))
(do
(log-info (str "sx:route deps miss for " page-name))
(log-info
(str "sx:route deps miss for " page-name))
false)
(let
((io-deps (get match "io-deps"))
@@ -1176,7 +1171,8 @@
render-plan
(let
((srv (or (get render-plan "server") (list)))
(cli (or (get render-plan "client") (list))))
(cli
(or (get render-plan "client") (list))))
(log-info
(str
"sx:route plan "
@@ -1190,7 +1186,8 @@
(if
(get match "stream")
(do
(log-info (str "sx:route streaming " pathname))
(log-info
(str "sx:route streaming " pathname))
(fetch-streaming
target
pathname
@@ -1366,14 +1363,15 @@
rendered
pathname)
true))))))))))))))))))
(define
bind-client-route-link
:effects (mutation io)
(fn
(link (href :as string))
(bind-client-route-click link href (fn () (bind-boost-link link href)))))
(bind-client-route-click
link
href
(fn () (bind-boost-link link href)))))
(define
process-sse
:effects (mutation io)
@@ -1387,7 +1385,6 @@
(mark-processed! el "sse")
(bind-sse el)))
(dom-query-all (or root (dom-body)) "[sx-sse]"))))
(define
bind-sse
:effects (mutation io)
@@ -1404,7 +1401,6 @@
source
event-name
(fn ((data :as string)) (bind-sse-swap el data))))))))
(define
bind-sse-swap
:effects (mutation io)
@@ -1443,7 +1439,6 @@
()
(swap-html-string target trimmed swap-style)
(post-swap target))))))))
(define
bind-inline-handlers
:effects (mutation io)
@@ -1472,7 +1467,11 @@
(fn
(e)
(host-call
(host-call (dom-window) "Function" "event" body)
(host-call
(dom-window)
"Function"
"event"
body)
"call"
el
e))
@@ -1493,7 +1492,6 @@
exprs)))))))))))
(dom-attr-list el)))
(dom-query-all (or root (dom-body)) "[sx-on\\:]"))))
(define
bind-preload-for
:effects (mutation io)
@@ -1519,7 +1517,6 @@
(do-preload
(get info "url")
(build-request-headers el (loaded-component-names))))))))))))
(define
do-preload
:effects (mutation io)
@@ -1528,11 +1525,9 @@
(when
(nil? (preload-cache-get _preload-cache url))
(fetch-preload url headers _preload-cache))))
(define
VERB_SELECTOR
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
(define
process-elements
:effects (mutation io)
@@ -1552,7 +1547,6 @@
(process-sse root)
(bind-inline-handlers root)
(process-emit-elements root)))
(define
process-one
:effects (mutation io)
@@ -1566,7 +1560,6 @@
(not (dom-has-attr? el "sx-disable"))
(do (bind-triggers el verb-info) (bind-preload-for el))
(bind-preload-for el))))))
(define
process-emit-elements
:effects (mutation io)
@@ -1592,10 +1585,12 @@
(let
((detail-json (dom-get-attr el "data-sx-emit-detail"))
(detail
(if detail-json (json-parse detail-json) (dict))))
(if
detail-json
(json-parse detail-json)
(dict))))
(dom-dispatch el event-name detail))))))))
els))))
(define
save-scroll-position
:effects (io)
@@ -1607,7 +1602,6 @@
(dict "scrollY" scrollY)
""
(browser-location-href)))))
(define
handle-popstate
:effects (mutation io)
@@ -1630,16 +1624,15 @@
(let
((headers (dict "SX-Request" "true")))
(fetch-and-restore target url headers scrollY))))))
(define
engine-init
:effects (mutation io)
(fn
()
(do (sx-process-scripts nil) (sx-hydrate nil) (process-elements nil))))
)) ;; end define-library
(do
(sx-process-scripts nil)
(sx-hydrate nil)
(process-elements nil)))))) ;; end define-library
;; Re-export to global namespace for backward compatibility
(import (web orchestration))

4
shared/static/wasm/sx/orchestration.sxbc
View File

File diff suppressed because one or more lines are too long

989
shared/static/wasm/sx/router.sx
View File

File diff suppressed because it is too large Load Diff

4
shared/static/wasm/sx/router.sxbc
View File

File diff suppressed because one or more lines are too long

17400
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",[]],["sx-7dd7570e",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-19f4e198",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-1549dd9c",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-cb04d103",[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

165
web/orchestration.sx
View File

@@ -6,7 +6,8 @@
(import (web adapter-dom))
(import (web engine))
(define-library (web orchestration)
(define-library
(web orchestration)
(export
_preload-cache
dispatch-trigger-events
@@ -68,9 +69,7 @@
handle-popstate
engine-init)
(begin
(define _preload-cache (dict))
(define
dispatch-trigger-events
:effects (mutation io)
@@ -83,7 +82,9 @@
(if
parsed
(for-each
(fn ((key :as string)) (dom-dispatch el key (get parsed key)))
(fn
((key :as string))
(dom-dispatch el key (get parsed key)))
(keys parsed))
(for-each
(fn
@@ -94,7 +95,6 @@
(not (empty? trimmed))
(dom-dispatch el trimmed (dict)))))
(split header-val ",")))))))
(define
execute-request
:effects (mutation io)
@@ -142,7 +142,6 @@
"SX-Prompt"
prompt-val)
extraParams))))))))))))
(define
do-fetch
:effects (mutation io)
@@ -254,9 +253,14 @@
(when
(not (abort-error? err))
(log-warn
(str "sx:fetch error " method " " final-url " — " err))
(str
"sx:fetch error "
method
" "
final-url
" — "
err))
(dom-dispatch el "sx:requestError" (dict "error" err))))))))))))
(define
handle-fetch-success
:effects (mutation io)
@@ -282,15 +286,27 @@
((target-el (if (get resp-headers "retarget") (dom-query (get resp-headers "retarget")) (resolve-target el)))
(swap-spec
(parse-swap-spec
(or (get resp-headers "reswap") (dom-get-attr el "sx-swap"))
(or
(get resp-headers "reswap")
(dom-get-attr el "sx-swap"))
(dom-has-class? (dom-body) "sx-transitions")))
(swap-style (get swap-spec "style"))
(use-transition (get swap-spec "transition"))
(ct (or (get resp-headers "content-type") "")))
(if
(contains? ct "text/sx")
(handle-sx-response el target-el text swap-style use-transition)
(handle-html-response el target-el text swap-style use-transition))
(handle-sx-response
el
target-el
text
swap-style
use-transition)
(handle-html-response
el
target-el
text
swap-style
use-transition))
(dispatch-trigger-events el (get resp-headers "trigger-swap"))
(handle-history el url resp-headers)
(set-timeout
@@ -307,7 +323,6 @@
el
"sx:afterSwap"
(dict "target" target-el "swap" swap-style)))))))
(define
flush-collected-styles
:effects (mutation io)
@@ -323,7 +338,6 @@
(dom-set-attr el "data-sx-css" "true")
(dom-set-prop el "textContent" (join "" rules))
(dom-append-to-head el))))))
(define
handle-sx-response
:effects (mutation io)
@@ -372,7 +386,6 @@
(= swap-style "outerHTML")
(dom-parent (or swap-result target))
(or swap-result target)))))))))))))))
(define
handle-html-response
:effects (mutation io)
@@ -437,7 +450,6 @@
(children-to-fragment container)
swap-style)
(post-swap target))))))))))
(define
handle-retry
:effects (mutation io)
@@ -463,7 +475,6 @@
(set-timeout
(fn () (do-fetch el verb method url extraParams))
ms)))))))
(define
bind-triggers
:effects (mutation io)
@@ -512,7 +523,6 @@
(= kind "event")
(bind-event el (get trigger "event") mods verbInfo))))
triggers))))
(define
bind-event
:effects (mutation io)
@@ -554,11 +564,14 @@
(when
(and
should-fire
(not (and (= event-name "click") (event-modifier-key? e))))
(not
(and (= event-name "click") (event-modifier-key? e))))
(when
(or
(= event-name "submit")
(and (= event-name "click") (dom-has-attr? el "href")))
(and
(= event-name "click")
(dom-has-attr? el "href")))
(prevent-default e))
(let
((live-info (get-verb-info el))
@@ -586,7 +599,9 @@
(when
is-get-link
(log-info
(str "sx:route server fetch " (get live-info "url"))))
(str
"sx:route server fetch "
(get live-info "url"))))
(if
(get mods "delay")
(do
@@ -598,13 +613,13 @@
(get mods "delay"))))
(execute-request el nil nil))))))))
(if (get mods "once") (dict "once" true) nil))))))
(define
post-swap
:effects (mutation io)
(fn
(root)
(log-info (str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(log-info
(str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(activate-scripts root)
(sx-process-scripts root)
(sx-hydrate root)
@@ -612,7 +627,6 @@
(run-post-render-hooks)
(flush-collected-styles)
(process-elements root)))
(define
process-settle-hooks
:effects (mutation io)
@@ -625,7 +639,6 @@
(let
((exprs (sx-parse settle-expr)))
(for-each (fn (expr) (cek-eval expr)) exprs))))))
(define
activate-scripts
:effects (mutation io)
@@ -647,7 +660,6 @@
(dom-set-attr live "data-sx-activated" "true")
(dom-replace-child (dom-parent dead) live dead))))
scripts)))))
(define
process-oob-swaps
:effects (mutation io)
@@ -668,7 +680,6 @@
(dom-remove-child (dom-parent oob-el) oob-el))
(when target (swap-fn target oob-el swap-type))))
oobs))))
(define
hoist-head-elements
:effects (mutation io)
@@ -685,10 +696,11 @@
(for-each
(fn
(link)
(when (dom-parent link) (dom-remove-child (dom-parent link) link))
(when
(dom-parent link)
(dom-remove-child (dom-parent link) link))
(dom-append-to-head link))
(dom-query-all container "link[rel=\"stylesheet\"]"))))
(define
process-boosted
:effects (mutation io)
@@ -697,7 +709,6 @@
(for-each
(fn (container) (boost-descendants container))
(dom-query-all (or root (dom-body)) "[sx-boost]"))))
(define
boost-descendants
:effects (mutation io)
@@ -738,7 +749,9 @@
(let
((method (upper (or (dom-get-attr form "method") "GET")))
(action
(or (dom-get-attr form "action") (browser-location-href))))
(or
(dom-get-attr form "action")
(browser-location-href))))
(when
(and
(not (dom-has-attr? form "sx-target"))
@@ -750,11 +763,8 @@
(dom-set-attr form "sx-swap" "innerHTML"))
(bind-boost-form form method action))))
(dom-query-all container "form")))))
(define _page-data-cache (dict))
(define _page-data-cache-ttl 30000)
(define
page-data-cache-key
:effects ()
@@ -773,7 +783,6 @@
(append! parts (str k "=" (get params k))))
(keys params))
(str base ":" (join "&" parts)))))))
(define
page-data-cache-get
:effects (mutation io)
@@ -788,14 +797,12 @@
(> (- (now-ms) (get entry "ts")) _page-data-cache-ttl)
(do (dict-set! _page-data-cache cache-key nil) nil)
(get entry "data"))))))
(define
page-data-cache-set
:effects (mutation io)
(fn
((cache-key :as string) data)
(dict-set! _page-data-cache cache-key {:data data :ts (now-ms)})))
(define
invalidate-page-cache
:effects (mutation io)
@@ -810,7 +817,6 @@
(keys _page-data-cache))
(sw-post-message {:type "invalidate" :page page-name})
(log-info (str "sx:cache invalidate " page-name))))
(define
invalidate-all-page-cache
:effects (mutation io)
@@ -819,7 +825,6 @@
(set! _page-data-cache (dict))
(sw-post-message {:type "invalidate" :page "*"})
(log-info "sx:cache invalidate *")))
(define
update-page-cache
:effects (mutation io)
@@ -829,7 +834,6 @@
((cache-key (page-data-cache-key page-name (dict))))
(page-data-cache-set cache-key data)
(log-info (str "sx:cache update " page-name)))))
(define
process-cache-directives
:effects (mutation io)
@@ -858,9 +862,7 @@
(let
((data (parse-sx-data response-text)))
(when data (update-page-cache hdr-update data)))))))
(define _optimistic-snapshots (dict))
(define
optimistic-cache-update
:effects (mutation)
@@ -875,7 +877,6 @@
(dict-set! _optimistic-snapshots cache-key cached)
(page-data-cache-set cache-key predicted)
predicted)))))
(define
optimistic-cache-revert
:effects (mutation)
@@ -888,14 +889,12 @@
(page-data-cache-set cache-key snapshot)
(dict-delete! _optimistic-snapshots cache-key)
snapshot))))
(define
optimistic-cache-confirm
:effects (mutation)
(fn
((cache-key :as string))
(dict-delete! _optimistic-snapshots cache-key)))
(define
submit-mutation
:effects (mutation io)
@@ -925,20 +924,16 @@
(let
((reverted (optimistic-cache-revert cache-key)))
(when reverted (try-rerender-page page-name params reverted))
(log-warn (str "sx:optimistic reverted " page-name ": " error))
(log-warn
(str "sx:optimistic reverted " page-name ": " error))
(when on-complete (on-complete "reverted"))))))))
(define _is-online true)
(define _offline-queue (list))
(define offline-is-online? :effects (io) (fn () _is-online))
(define
offline-set-online!
:effects (mutation)
(fn ((val :as boolean)) (set! _is-online val)))
(define
offline-queue-mutation
:effects (mutation io)
@@ -976,7 +971,6 @@
(len _offline-queue)
" pending)"))
entry)))
(define
offline-sync
:effects (mutation io)
@@ -996,7 +990,8 @@
(fn
(result)
(dict-set! entry "status" "synced")
(log-info (str "sx:offline synced " (get entry "action"))))
(log-info
(str "sx:offline synced " (get entry "action"))))
(fn
((error :as string))
(dict-set! entry "status" "failed")
@@ -1007,7 +1002,6 @@
": "
error)))))
pending)))))
(define
offline-pending-count
:effects (io)
@@ -1017,7 +1011,6 @@
(filter
(fn ((e :as dict)) (= (get e "status") "pending"))
_offline-queue))))
(define
offline-aware-mutation
:effects (mutation io)
@@ -1045,7 +1038,6 @@
params
mutator-fn)
(when on-complete (on-complete "queued"))))))
(define
current-page-layout
:effects (io)
@@ -1055,7 +1047,6 @@
((pathname (url-pathname (browser-location-href)))
(match (find-matching-route pathname _page-routes)))
(if (nil? match) "" (or (get match "layout") "")))))
(define
swap-rendered-content
:effects (mutation io)
@@ -1088,9 +1079,11 @@
(sx-hydrate-elements target)
(sx-hydrate-islands target)
(run-post-render-hooks)
(dom-dispatch target "sx:clientRoute" (dict "pathname" pathname))
(dom-dispatch
target
"sx:clientRoute"
(dict "pathname" pathname))
(log-info (str "sx:route client " pathname))))))))
(define
resolve-route-target
:effects (io)
@@ -1100,7 +1093,6 @@
(and target-sel (not (= target-sel "true")))
(dom-query target-sel)
nil)))
(define
deps-satisfied?
:effects (io)
@@ -1109,10 +1101,12 @@
(let
((deps (get match "deps")) (loaded (loaded-component-names)))
(if
(or (nil? deps) (empty? deps))
(nil? deps)
false
(if
(empty? deps)
true
(every? (fn ((dep :as string)) (contains? loaded dep)) deps)))))
(every? (fn ((dep :as string)) (contains? loaded dep)) deps))))))
(define
try-client-route
:effects (mutation io)
@@ -1166,7 +1160,8 @@
(if
(not (deps-satisfied? match))
(do
(log-info (str "sx:route deps miss for " page-name))
(log-info
(str "sx:route deps miss for " page-name))
false)
(let
((io-deps (get match "io-deps"))
@@ -1176,7 +1171,8 @@
render-plan
(let
((srv (or (get render-plan "server") (list)))
(cli (or (get render-plan "client") (list))))
(cli
(or (get render-plan "client") (list))))
(log-info
(str
"sx:route plan "
@@ -1190,7 +1186,8 @@
(if
(get match "stream")
(do
(log-info (str "sx:route streaming " pathname))
(log-info
(str "sx:route streaming " pathname))
(fetch-streaming
target
pathname
@@ -1366,14 +1363,15 @@
rendered
pathname)
true))))))))))))))))))
(define
bind-client-route-link
:effects (mutation io)
(fn
(link (href :as string))
(bind-client-route-click link href (fn () (bind-boost-link link href)))))
(bind-client-route-click
link
href
(fn () (bind-boost-link link href)))))
(define
process-sse
:effects (mutation io)
@@ -1387,7 +1385,6 @@
(mark-processed! el "sse")
(bind-sse el)))
(dom-query-all (or root (dom-body)) "[sx-sse]"))))
(define
bind-sse
:effects (mutation io)
@@ -1404,7 +1401,6 @@
source
event-name
(fn ((data :as string)) (bind-sse-swap el data))))))))
(define
bind-sse-swap
:effects (mutation io)
@@ -1443,7 +1439,6 @@
()
(swap-html-string target trimmed swap-style)
(post-swap target))))))))
(define
bind-inline-handlers
:effects (mutation io)
@@ -1472,7 +1467,11 @@
(fn
(e)
(host-call
(host-call (dom-window) "Function" "event" body)
(host-call
(dom-window)
"Function"
"event"
body)
"call"
el
e))
@@ -1493,7 +1492,6 @@
exprs)))))))))))
(dom-attr-list el)))
(dom-query-all (or root (dom-body)) "[sx-on\\:]"))))
(define
bind-preload-for
:effects (mutation io)
@@ -1519,7 +1517,6 @@
(do-preload
(get info "url")
(build-request-headers el (loaded-component-names))))))))))))
(define
do-preload
:effects (mutation io)
@@ -1528,11 +1525,9 @@
(when
(nil? (preload-cache-get _preload-cache url))
(fetch-preload url headers _preload-cache))))
(define
VERB_SELECTOR
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
(define
process-elements
:effects (mutation io)
@@ -1552,7 +1547,6 @@
(process-sse root)
(bind-inline-handlers root)
(process-emit-elements root)))
(define
process-one
:effects (mutation io)
@@ -1566,7 +1560,6 @@
(not (dom-has-attr? el "sx-disable"))
(do (bind-triggers el verb-info) (bind-preload-for el))
(bind-preload-for el))))))
(define
process-emit-elements
:effects (mutation io)
@@ -1592,10 +1585,12 @@
(let
((detail-json (dom-get-attr el "data-sx-emit-detail"))
(detail
(if detail-json (json-parse detail-json) (dict))))
(if
detail-json
(json-parse detail-json)
(dict))))
(dom-dispatch el event-name detail))))))))
els))))
(define
save-scroll-position
:effects (io)
@@ -1607,7 +1602,6 @@
(dict "scrollY" scrollY)
""
(browser-location-href)))))
(define
handle-popstate
:effects (mutation io)
@@ -1630,16 +1624,15 @@
(let
((headers (dict "SX-Request" "true")))
(fetch-and-restore target url headers scrollY))))))
(define
engine-init
:effects (mutation io)
(fn
()
(do (sx-process-scripts nil) (sx-hydrate nil) (process-elements nil))))
)) ;; end define-library
(do
(sx-process-scripts nil)
(sx-hydrate nil)
(process-elements nil)))))) ;; end define-library
;; Re-export to global namespace for backward compatibility
(import (web orchestration))

989
web/router.sx
View File

File diff suppressed because it is too large Load Diff

34
web/tests/test-router.sx
View File

@@ -208,16 +208,34 @@
;; find-matching-route with SX URLs
;; --------------------------------------------------------------------------
(defsuite "find-matching-route-sx-urls"
(deftest "SX URL auto-converts for matching"
(let ((routes (list
{:pattern "/language/docs/<slug>"
:parsed (parse-route-pattern "/language/docs/<slug>")
:name "docs-page"})))
(let ((result (find-matching-route "/(language.(doc.introduction))" routes)))
(defsuite
"find-matching-route-sx-urls"
(deftest
"SX URL auto-converts for matching"
(let
((routes (list {:parsed (parse-route-pattern "/language/docs/<slug>") :pattern "/language/docs/<slug>" :name "docs-page"})))
(let
((result (find-matching-route "/(language.(doc.introduction))" routes)))
(assert-true (not (nil? result)))
(assert-equal "docs-page" (get result "name"))
(assert-equal "introduction" (get (get result "params") "slug"))))))
(assert-equal "introduction" (get (get result "params") "slug")))))
(deftest
"SX URL with /sx/ prefix auto-converts"
(let
((routes (list {:parsed (parse-route-pattern "/language/docs/<slug>") :pattern "/language/docs/<slug>" :name "docs-page"})))
(let
((result (find-matching-route "/sx/(language.(doc.introduction))" routes)))
(assert-true (not (nil? result)))
(assert-equal "docs-page" (get result "name"))
(assert-equal "introduction" (get (get result "params") "slug")))))
(deftest
"SX URL with custom prefix auto-converts"
(let
((routes (list {:parsed (parse-route-pattern "/geography/") :pattern "/geography/" :name "geo-index"})))
(let
((result (find-matching-route "/myapp/(geography)" routes)))
(assert-true (not (nil? result)))
(assert-equal "geo-index" (get result "name"))))))
;; ==========================================================================