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

67
web/adapter-sx.sx
View File

@@ -50,12 +50,12 @@
(aser-list expr env))
;; Spread — emit attrs to nearest element provider
"spread" (do (emit! "element-attrs" (spread-attrs expr)) nil)
"spread" (do (scope-emit! "element-attrs" (spread-attrs expr)) nil)
:else expr)))
;; Catch spread values from function calls and symbol lookups
(if (spread? result)
(do (emit! "element-attrs" (spread-attrs result)) nil)
(do (scope-emit! "element-attrs" (spread-attrs result)) nil)
result))))
@@ -119,18 +119,34 @@
(for-each
(fn (c)
(let ((result (aser c env)))
(if (= (type-of result) "list")
(for-each
(fn (item)
(when (not (nil? item))
(append! parts (serialize item))))
result)
(when (not (nil? result))
(append! parts (serialize result))))))
(cond
(nil? result) nil
;; Serialized SX from aser (tags, components, fragments)
;; starts with "(" — use directly without re-quoting
(and (= (type-of result) "string")
(> (string-length result) 0)
(starts-with? result "("))
(append! parts result)
;; list results (from map etc.)
(= (type-of result) "list")
(for-each
(fn (item)
(when (not (nil? item))
(if (and (= (type-of item) "string")
(> (string-length item) 0)
(starts-with? item "("))
(append! parts item)
(append! parts (serialize item)))))
result)
;; Everything else — serialize normally (quotes strings)
:else
(append! parts (serialize result)))))
children)
(if (empty? parts)
""
(str "(<> " (join " " parts) ")")))))
(if (= (len parts) 1)
(first parts)
(str "(<> " (join " " parts) ")"))))))
(define aser-call :effects [render]
@@ -160,13 +176,26 @@
(set! i (inc i)))
(let ((val (aser arg env)))
(when (not (nil? val))
(if (= (type-of val) "list")
(for-each
(fn (item)
(when (not (nil? item))
(append! child-parts (serialize item))))
val)
(append! child-parts (serialize val))))
(cond
;; Serialized SX (tags, components) — use directly
(and (= (type-of val) "string")
(> (string-length val) 0)
(starts-with? val "("))
(append! child-parts val)
;; List results (from map etc.)
(= (type-of val) "list")
(for-each
(fn (item)
(when (not (nil? item))
(if (and (= (type-of item) "string")
(> (string-length item) 0)
(starts-with? item "("))
(append! child-parts item)
(append! child-parts (serialize item)))))
val)
;; Plain values — serialize normally
:else
(append! child-parts (serialize val))))
(set! i (inc i))))))
args)
;; Collect emitted spread attrs — goes after explicit attrs, before children
@@ -178,7 +207,7 @@
(append! attr-parts (str ":" k))
(append! attr-parts (serialize v))))
(keys spread-dict)))
(emitted "element-attrs"))
(scope-peek "element-attrs"))
(scope-pop! "element-attrs")
(let ((parts (concat (list name) attr-parts child-parts)))
(str "(" (join " " parts) ")")))))

24
web/boot.sx
View File

@@ -336,11 +336,15 @@
(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)
(when (not (is-processed? el "island-hydrated"))
(mark-processed! el "island-hydrated")
(hydrate-island el)))
(if (is-processed? el "island-hydrated")
(log-info (str " skip (already hydrated): " (dom-get-attr el "data-sx-island")))
(do
(log-info (str " hydrating: " (dom-get-attr el "data-sx-island")))
(mark-processed! el "island-hydrated")
(hydrate-island el))))
els))))
(define hydrate-island :effects [mutation io]
@@ -398,7 +402,9 @@
(fn ((d :as lambda))
(when (callable? d) (d)))
disposers)
(dom-set-data el "sx-disposers" nil)))))
(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)
@@ -416,6 +422,16 @@
(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.

10
web/orchestration.sx
View File

@@ -291,8 +291,12 @@
(content (if select-sel
(select-from-container container select-sel)
(children-to-fragment container))))
;; Dispose old islands before swap
(dispose-islands-in target)
;; Dispose old islands before swap.
;; outerHTML replaces the target entirely — force-dispose all islands.
;; Other swap styles (innerHTML, beforeend, etc.) may preserve islands.
(if (= swap-style "outerHTML")
(force-dispose-islands-in target)
(dispose-islands-in target))
;; Swap
(with-transition use-transition
(fn ()
@@ -456,6 +460,7 @@
(define post-swap :effects [mutation io]
(fn (root)
;; Run lifecycle after swap: activate scripts, process SX, hydrate, process
(log-info (str "post-swap: root=" (if root (dom-tag-name root) "nil")))
(activate-scripts root)
(sx-process-scripts root)
(sx-hydrate root)
@@ -871,6 +876,7 @@
(hoist-head-elements-full target)
(process-elements target)
(sx-hydrate-elements target)
(sx-hydrate-islands target)
(run-post-render-hooks)
(dom-dispatch target "sx:clientRoute"
(dict "pathname" pathname))