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

OCaml evaluator for page dispatch + handler aser, 83/83 Playwright tests

Browse Source 
Major architectural change: page function dispatch and handler execution
now go through the OCaml kernel instead of the Python bootstrapped evaluator.

OCaml integration:
- Page dispatch: bridge.eval() evaluates SX URL expressions (geography, marshes, etc.)
- Handler aser: bridge.aser() serializes handler responses as SX wire format
- _ensure_components loads all .sx files into OCaml kernel (spec, web adapter, handlers)
- defhandler/defpage registered as no-op special forms so handler files load
- helper IO primitive dispatches to Python page helpers + IO handlers
- ok-raw response format for SX wire format (no double-escaping)
- Natural list serialization in eval (no (list ...) wrapper)
- Clean pipe: _read_until_ok always sends io-response on error

SX adapter (aser):
- scope-emit!/scope-peek aliases to avoid CEK special form conflict
- aser-fragment/aser-call: strings starting with "(" pass through unserialized
- Registered cond-scheme?, is-else-clause?, primitive?, get-primitive in kernel
- random-int, parse-int as kernel primitives; json-encode, into via IO bridge

Handler migration:
- All IO calls converted to (helper "name" args...) pattern
- request-arg, request-form, state-get, state-set!, now, component-source etc.
- Fixed bare (effect ...) in island bodies leaking disposer functions as text
- Fixed lower-case → lower, ~search-results → ~examples/search-results

Reactive islands:
- sx-hydrate-islands called after client-side navigation swap
- force-dispose-islands-in for outerHTML swaps (clears hydration markers)
- clear-processed! platform primitive for re-hydration

Content restructuring:
- Design, event bridge, named stores, phase 2 consolidated into reactive overview
- Marshes split into overview + 5 example sub-pages
- Nav links use sx-get/sx-target for client-side navigation

Playwright test suite (sx/tests/test_demos.py):
- 83 tests covering hypermedia demos, reactive islands, marshes, spec explorer
- Server-side rendering, handler interactions, island hydration, navigation

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-18 17:22:51 +00:00
parent 5b6e883e6d
commit 71c2003a60
33 changed files with 1848 additions and 852 deletions
Download Patch File Download Diff File Expand all files Collapse all files

251
sx/sx/page-functions.sx
View File

@@ -1,22 +1,51 @@
;; SX docs page functions — section + page dispatch for GraphSX URL routing.
;;
;; IMPORTANT: Page functions return QUOTED expressions (unevaluated ASTs).
;; The Python router evaluates these functions with async_eval to get the AST,
;; then passes it through _eval_slot (aser) for component expansion and HTML
;; tag handling. This two-phase approach is necessary because eval_expr doesn't
;; handle HTML tags — only the aser/render paths do.
;; Page functions return QUOTED expressions (unevaluated ASTs).
;; The router evaluates these via the OCaml kernel (or Python fallback).
;;
;; Pattern:
;; Simple: '(~component-name)
;; Data: (let ((data (helper))) `(~component :key ,val))
;; Data: (let ((data (helper "name" arg))) `(~component :key ,val))
;;
;; URL eval: /(language.(doc.introduction))
;; → (language (doc "introduction"))
;; → async_eval returns [Symbol("~docs-content/docs-introduction-content")]
;; → _eval_slot wraps in (~layouts/doc :path "..." <ast>) and renders via aser
;; IO: Application data is fetched via the (helper name ...) IO primitive,
;; which dispatches to Python page helpers through the coroutine bridge.
;; This keeps the spec clean — no application functions leak into the kernel.
;; ---------------------------------------------------------------------------
;; Convention-based page dispatch
;; ---------------------------------------------------------------------------
;;
;; NOTE: Lambda &rest is not supported by call-lambda in the current spec.
;; All functions take explicit positional params; missing args default to nil.
;; Most page functions are boilerplate: slug → component name via a naming
;; convention. Instead of hand-writing case statements, derive the component
;; symbol from the slug at runtime.
;;
;; Naming conventions:
;; essay: "sx-sucks" → ~essays/sx-sucks/essay-sx-sucks
;; plan: "status" → ~plans/status/plan-status-content
;; example: "tabs" → ~examples-content/example-tabs
;; protocol: "fragments" → ~protocols/fragments-content
;; cssx: "patterns" → ~cssx/patterns-content
;; ri-example: "counter" → ~reactive-islands/demo/example-counter
;; Build a component symbol from a slug and a naming pattern.
;; Pattern: prefix + slug + infix + slug + suffix
;; When infix is nil, slug appears once: prefix + slug + suffix
(define slug->component
(fn (slug prefix infix suffix)
(if infix
(make-symbol (str prefix slug infix slug suffix))
(make-symbol (str prefix slug suffix)))))
;; Make a simple slug-dispatcher: given a naming convention, returns a function
;; that maps (slug) → '(~derived-component-name).
;; default-name is a STRING of the component name for the nil-slug (index) case.
;; (We use a string + make-symbol because bare ~symbols get evaluated as lookups.)
(define make-page-fn
(fn (default-name prefix infix suffix)
(fn (slug)
(if (nil? slug)
(list (make-symbol default-name))
(list (slug->component slug prefix infix suffix))))))
;; ---------------------------------------------------------------------------
;; Section functions — structural, pass through content or return index
@@ -49,16 +78,15 @@
(if (nil? content) nil content)))
(define reactive
(fn (slug)
(if (nil? slug)
(fn (content)
(if (nil? content)
'(~reactive-islands/index/reactive-islands-index-content)
(case slug
"demo" '(~reactive-islands/demo/reactive-islands-demo-content)
"event-bridge" '(~reactive-islands/event-bridge/reactive-islands-event-bridge-content)
"named-stores" '(~reactive-islands/named-stores/reactive-islands-named-stores-content)
"plan" '(~reactive-islands/plan/reactive-islands-plan-content)
"phase2" '(~reactive-islands/phase2/reactive-islands-phase2-content)
:else '(~reactive-islands/index/reactive-islands-index-content)))))
content)))
;; Convention: ~reactive-islands/demo/example-{slug}
(define examples
(make-page-fn "~reactive-islands/demo/reactive-islands-demo-content" "~reactive-islands/demo/example-" nil ""))
(define cek
(fn (slug)
@@ -83,8 +111,16 @@
(if (nil? content) '(~geography/spreads-content) content)))
(define marshes
(fn (content)
(if (nil? content) '(~reactive-islands/marshes/reactive-islands-marshes-content) content)))
(fn (slug)
(if (nil? slug)
'(~reactive-islands/marshes/reactive-islands-marshes-content)
(case slug
"hypermedia-feeds" '(~reactive-islands/marshes/example-hypermedia-feeds)
"server-signals" '(~reactive-islands/marshes/example-server-signals)
"on-settle" '(~reactive-islands/marshes/example-on-settle)
"signal-triggers" '(~reactive-islands/marshes/example-signal-triggers)
"view-transform" '(~reactive-islands/marshes/example-view-transform)
:else '(~reactive-islands/marshes/reactive-islands-marshes-content)))))
(define isomorphism
(fn (slug)
@@ -92,7 +128,7 @@
'(~plans/isomorphic/plan-isomorphic-content)
(case slug
"bundle-analyzer"
(let ((data (bundle-analyzer-data)))
(let ((data (helper "bundle-analyzer-data")))
`(~analyzer/bundle-analyzer-content
:pages ,(get data "pages")
:total-components ,(get data "total-components")
@@ -100,7 +136,7 @@
:pure-count ,(get data "pure-count")
:io-count ,(get data "io-count")))
"routing-analyzer"
(let ((data (routing-analyzer-data)))
(let ((data (helper "routing-analyzer-data")))
`(~routing-analyzer/content
:pages ,(get data "pages")
:total-pages ,(get data "total-pages")
@@ -108,7 +144,7 @@
:server-count ,(get data "server-count")
:registry-sample ,(get data "registry-sample")))
"data-test"
(let ((data (data-test-data)))
(let ((data (helper "data-test-data")))
`(~data-test/content
:server-time ,(get data "server-time")
:items ,(get data "items")
@@ -116,17 +152,17 @@
:transport ,(get data "transport")))
"async-io" '(~async-io-demo/content)
"affinity"
(let ((data (affinity-demo-data)))
(let ((data (helper "affinity-demo-data")))
`(~affinity-demo/content
:components ,(get data "components")
:page-plans ,(get data "page-plans")))
"optimistic"
(let ((data (optimistic-demo-data)))
(let ((data (helper "optimistic-demo-data")))
`(~optimistic-demo/content
:items ,(get data "items")
:server-time ,(get data "server-time")))
"offline"
(let ((data (offline-demo-data)))
(let ((data (helper "offline-demo-data")))
`(~offline-demo/content
:notes ,(get data "notes")
:server-time ,(get data "server-time")))
@@ -148,11 +184,11 @@
"components" '(~docs-content/docs-components-content)
"evaluator" '(~docs-content/docs-evaluator-content)
"primitives"
(let ((data (primitives-data)))
(let ((data (helper "primitives-data")))
`(~docs-content/docs-primitives-content
:prims (~docs/primitives-tables :primitives ,data)))
"special-forms"
(let ((data (special-forms-data)))
(let ((data (helper "special-forms-data")))
`(~docs-content/docs-special-forms-content
:forms (~docs/special-forms-tables :forms ,data)))
"server-rendering" '(~docs-content/docs-server-rendering-content)
@@ -184,7 +220,7 @@
`(~specs/overview-content :spec-title "Extensions" :spec-files ,files))
:else (let ((found-spec (find-spec slug)))
(if found-spec
(let ((src (read-spec-file (get found-spec "filename"))))
(let ((src (helper "read-spec-file" (get found-spec "filename"))))
`(~specs/detail-content
:spec-title ,(get found-spec "title")
:spec-desc ,(get found-spec "desc")
@@ -200,7 +236,7 @@
'(~specs/architecture-content)
(let ((found-spec (find-spec slug)))
(if found-spec
(let ((data (spec-explorer-data
(let ((data (helper "spec-explorer-data"
(get found-spec "filename")
(get found-spec "title")
(get found-spec "desc"))))
@@ -216,7 +252,7 @@
(dict :title (get item "title") :desc (get item "desc")
:prose (get item "prose")
:filename (get item "filename") :href (str "/sx/(language.(spec." (get item "slug") "))")
:source (read-spec-file (get item "filename"))))
:source (helper "read-spec-file" (get item "filename"))))
items)))
;; Bootstrappers (under language)
@@ -224,7 +260,7 @@
(fn (slug)
(if (nil? slug)
'(~specs/bootstrappers-index-content)
(let ((data (bootstrapper-data slug)))
(let ((data (helper "bootstrapper-data" slug)))
(if (get data "bootstrapper-not-found")
`(~specs/not-found :slug ,slug)
(case slug
@@ -250,7 +286,7 @@
:bootstrapper-source ,(get data "bootstrapper-source")
:bootstrapped-output ,(get data "bootstrapped-output"))
"page-helpers"
(let ((ph-data (page-helpers-demo-data)))
(let ((ph-data (helper "page-helpers-demo-data")))
`(~page-helpers-demo/content
:sf-categories ,(get ph-data "sf-categories")
:sf-total ,(get ph-data "sf-total")
@@ -277,7 +313,7 @@
(define test
(fn (slug)
(if (nil? slug)
(let ((data (run-modular-tests "all")))
(let ((data (helper "run-modular-tests""all")))
`(~testing/overview-content
:server-results ,(get data "server-results")
:framework-source ,(get data "framework-source")
@@ -290,7 +326,7 @@
(case slug
"runners" '(~testing/runners-content)
:else
(let ((data (run-modular-tests slug)))
(let ((data (helper "run-modular-tests"slug)))
(case slug
"eval" `(~testing/spec-content
:spec-name "eval" :spec-title "Evaluator Tests"
@@ -342,7 +378,7 @@
(fn (slug)
(if (nil? slug)
'(~examples/reference-index-content)
(let ((data (reference-data slug)))
(let ((data (helper "reference-data" slug)))
(case slug
"attributes" `(~reference/attrs-content
:req-table (~docs/attr-table-from-data :title "Request Attributes" :attrs ,(get data "req-attrs"))
@@ -371,7 +407,7 @@
(if (nil? slug) nil
(case kind
"attributes"
(let ((data (attr-detail-data slug)))
(let ((data (helper "attr-detail-data" slug)))
(if (get data "attr-not-found")
`(~reference/attr-not-found :slug ,slug)
`(~reference/attr-detail-content
@@ -382,7 +418,7 @@
:handler-code ,(get data "attr-handler")
:wire-placeholder-id ,(get data "attr-wire-id"))))
"headers"
(let ((data (header-detail-data slug)))
(let ((data (helper "header-detail-data" slug)))
(if (get data "header-not-found")
`(~reference/attr-not-found :slug ,slug)
`(~reference/header-detail-content
@@ -392,7 +428,7 @@
:example-code ,(get data "header-example")
:demo ,(get data "header-demo"))))
"events"
(let ((data (event-detail-data slug)))
(let ((data (helper "event-detail-data" slug)))
(if (get data "event-not-found")
`(~reference/attr-not-found :slug ,slug)
`(~reference/event-detail-content
@@ -403,39 +439,11 @@
:else nil))))
;; Examples (under geography → hypermedia)
;; Convention: ~examples-content/example-{slug}
(define example
(fn (slug)
(if (nil? slug)
nil
(case slug
"click-to-load" '(~examples-content/example-click-to-load)
"form-submission" '(~examples-content/example-form-submission)
"polling" '(~examples-content/example-polling)
"delete-row" '(~examples-content/example-delete-row)
"inline-edit" '(~examples-content/example-inline-edit)
"oob-swaps" '(~examples-content/example-oob-swaps)
"lazy-loading" '(~examples-content/example-lazy-loading)
"infinite-scroll" '(~examples-content/example-infinite-scroll)
"progress-bar" '(~examples-content/example-progress-bar)
"active-search" '(~examples-content/example-active-search)
"inline-validation" '(~examples-content/example-inline-validation)
"value-select" '(~examples-content/example-value-select)
"reset-on-submit" '(~examples-content/example-reset-on-submit)
"edit-row" '(~examples-content/example-edit-row)
"bulk-update" '(~examples-content/example-bulk-update)
"swap-positions" '(~examples-content/example-swap-positions)
"select-filter" '(~examples-content/example-select-filter)
"tabs" '(~examples-content/example-tabs)
"animations" '(~examples-content/example-animations)
"dialogs" '(~examples-content/example-dialogs)
"keyboard-shortcuts" '(~examples-content/example-keyboard-shortcuts)
"put-patch" '(~examples-content/example-put-patch)
"json-encoding" '(~examples-content/example-json-encoding)
"vals-and-headers" '(~examples-content/example-vals-and-headers)
"loading-states" '(~examples-content/example-loading-states)
"sync-replace" '(~examples-content/example-sync-replace)
"retry" '(~examples-content/example-retry)
:else '(~examples-content/example-click-to-load)))))
(if (nil? slug) nil
(list (slug->component slug "~examples-content/example-" nil "")))))
;; SX URLs (under applications)
(define sx-urls
@@ -443,59 +451,19 @@
'(~sx-urls/urls-content)))
;; CSSX (under applications)
;; Convention: ~cssx/{slug}-content
(define cssx
(fn (slug)
(if (nil? slug)
'(~cssx/overview-content)
(case slug
"patterns" '(~cssx/patterns-content)
"delivery" '(~cssx/delivery-content)
"async" '(~cssx/async-content)
"live" '(~cssx/live-content)
"comparisons" '(~cssx/comparison-content)
"philosophy" '(~cssx/philosophy-content)
:else '(~cssx/overview-content)))))
(make-page-fn "~cssx/overview-content" "~cssx/" nil "-content"))
;; Protocols (under applications)
;; Convention: ~protocols/{slug}-content
(define protocol
(fn (slug)
(if (nil? slug)
'(~protocols/wire-format-content)
(case slug
"wire-format" '(~protocols/wire-format-content)
"fragments" '(~protocols/fragments-content)
"resolver-io" '(~protocols/resolver-io-content)
"internal-services" '(~protocols/internal-services-content)
"activitypub" '(~protocols/activitypub-content)
"future" '(~protocols/future-content)
:else '(~protocols/wire-format-content)))))
(make-page-fn "~protocols/wire-format-content" "~protocols/" nil "-content"))
;; Essays (under etc)
;; Convention: ~essays/{slug}/essay-{slug}
(define essay
(fn (slug)
(if (nil? slug)
'(~essays/index/essays-index-content)
(case slug
"sx-sucks" '(~essays/sx-sucks/essay-sx-sucks)
"why-sexps" '(~essays/why-sexps/essay-why-sexps)
"htmx-react-hybrid" '(~essays/htmx-react-hybrid/essay-htmx-react-hybrid)
"on-demand-css" '(~essays/on-demand-css/essay-on-demand-css)
"client-reactivity" '(~essays/client-reactivity/essay-client-reactivity)
"sx-native" '(~essays/sx-native/essay-sx-native)
"tail-call-optimization" '(~essays/tail-call-optimization/essay-tail-call-optimization)
"continuations" '(~essays/continuations/essay-continuations)
"reflexive-web" '(~essays/reflexive-web/essay-reflexive-web)
"server-architecture" '(~essays/server-architecture/essay-server-architecture)
"separation-of-concerns" '(~essays/separation-of-concerns/essay-separation-of-concerns)
"sx-and-ai" '(~essays/sx-and-ai/essay-sx-and-ai)
"no-alternative" '(~essays/no-alternative/essay-no-alternative)
"zero-tooling" '(~essays/zero-tooling/essay-zero-tooling)
"react-is-hypermedia" '(~essays/react-is-hypermedia/essay-react-is-hypermedia)
"hegelian-synthesis" '(~essays/hegelian-synthesis/essay-hegelian-synthesis)
"the-art-chain" '(~essays/the-art-chain/essay-the-art-chain)
"self-defining-medium" '(~essays/self-defining-medium/essay-self-defining-medium)
"hypermedia-age-of-ai" '(~essays/hypermedia-age-of-ai/essay-hypermedia-age-of-ai)
:else '(~essays/index/essays-index-content)))))
(make-page-fn "~essays/index/essays-index-content" "~essays/" "/essay-" ""))
;; Philosophy (under etc)
(define philosophy
@@ -512,47 +480,6 @@
:else '(~essays/philosophy-index/content)))))
;; Plans (under etc)
;; Convention: ~plans/{slug}/plan-{slug}-content
(define plan
(fn (slug)
(if (nil? slug)
'(~plans/index/plans-index-content)
(case slug
"status" '(~plans/status/plan-status-content)
"reader-macros" '(~plans/reader-macros/plan-reader-macros-content)
"reader-macro-demo" '(~plans/reader-macro-demo/plan-reader-macro-demo-content)
"theorem-prover"
(let ((data (prove-data)))
'(~plans/theorem-prover/plan-theorem-prover-content))
"self-hosting-bootstrapper" '(~plans/self-hosting-bootstrapper/plan-self-hosting-bootstrapper-content)
"js-bootstrapper" '(~plans/js-bootstrapper/plan-js-bootstrapper-content)
"sx-activity" '(~plans/sx-activity/plan-sx-activity-content)
"predictive-prefetch" '(~plans/predictive-prefetch/plan-predictive-prefetch-content)
"content-addressed-components" '(~plans/content-addressed-components/plan-content-addressed-components-content)
"environment-images" '(~plans/environment-images/plan-environment-images-content)
"runtime-slicing" '(~plans/runtime-slicing/plan-runtime-slicing-content)
"typed-sx" '(~plans/typed-sx/plan-typed-sx-content)
"nav-redesign" '(~plans/nav-redesign/plan-nav-redesign-content)
"fragment-protocol" '(~plans/fragment-protocol/plan-fragment-protocol-content)
"glue-decoupling" '(~plans/glue-decoupling/plan-glue-decoupling-content)
"social-sharing" '(~plans/social-sharing/plan-social-sharing-content)
"sx-ci" '(~plans/sx-ci/plan-sx-ci-content)
"live-streaming" '(~plans/live-streaming/plan-live-streaming-content)
"sx-web-platform" '(~plans/sx-web-platform/plan-sx-web-platform-content)
"sx-forge" '(~plans/sx-forge/plan-sx-forge-content)
"sx-swarm" '(~plans/sx-swarm/plan-sx-swarm-content)
"sx-proxy" '(~plans/sx-proxy/plan-sx-proxy-content)
"mother-language" '(~plans/mother-language/plan-mother-language-content)
"isolated-evaluator" '(~plans/isolated-evaluator/plan-isolated-evaluator-content)
"rust-wasm-host" '(~plans/rust-wasm-host/plan-rust-wasm-host-content)
"async-eval-convergence" '(~plans/async-eval-convergence/plan-async-eval-convergence-content)
"wasm-bytecode-vm" '(~plans/wasm-bytecode-vm/plan-wasm-bytecode-vm-content)
"generative-sx" '(~plans/generative-sx/plan-generative-sx-content)
"art-dag-sx" '(~plans/art-dag-sx/plan-art-dag-sx-content)
"spec-explorer" '(~plans/spec-explorer/plan-spec-explorer-content)
"sx-urls" '(~plans/sx-urls/plan-sx-urls-content)
"sx-protocol" '(~plans/sx-protocol/plan-sx-protocol-content)
"scoped-effects" '(~plans/scoped-effects/plan-scoped-effects-content)
"foundations" '(~plans/foundations/plan-foundations-content)
"cek-reactive" '(~plans/cek-reactive/plan-cek-reactive-content)
"reactive-runtime" '(~plans/reactive-runtime/plan-reactive-runtime-content)
:else '(~plans/index/plans-index-content)))))
(make-page-fn "~plans/index/plans-index-content" "~plans/" "/plan-" "-content"))