coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
153f02c6729fd6260c93dfcedaf4a321d4f3fee7
rose-ash/sx/sx/specs-explorer.sx
giles 71c2003a60 OCaml evaluator for page dispatch + handler aser, 83/83 Playwright tests 
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>
2026-03-18 17:22:51 +00:00

257 lines
11 KiB
Plaintext
Raw Blame History

;; ---------------------------------------------------------------------------
;; Spec Explorer — structured interactive view of SX spec files
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-explorer-content (&key data) :affinity :server
(~docs/page :title (str (get data "title") " — Explorer")
;; Header with filename and source link
(~specs-explorer/spec-explorer-header
:filename (get data "filename")
:title (get data "title")
:desc (get data "desc")
:slug (replace (get data "filename") ".sx" ""))
;; Stats bar
(~specs-explorer/spec-explorer-stats :stats (get data "stats"))
;; Sections
(map (fn (section)
(~specs-explorer/spec-explorer-section :section section))
(get data "sections"))
;; Platform interface
(when (not (empty? (get data "platform-interface")))
(~specs-explorer/spec-platform-interface :items (get data "platform-interface")))))
;; ---------------------------------------------------------------------------
;; Header
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-explorer-header (&key filename title desc slug)
(div :class "mb-6"
(div :class "flex items-center justify-between"
(div
(h1 :class "text-2xl font-bold text-stone-800" title)
(p :class "text-sm text-stone-500 mt-1" desc))
(a :href (str "/sx/(language.(spec." slug "))")
:sx-get (str "/sx/(language.(spec." slug "))")
:sx-target "#main-panel" :sx-select "#main-panel"
:sx-swap "outerHTML" :sx-push-url "true"
:class "text-sm text-violet-600 hover:text-violet-800 font-medium"
"View Source"))
(p :class "text-xs text-stone-400 font-mono mt-2" filename)))
;; ---------------------------------------------------------------------------
;; Stats bar
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-explorer-stats (&key stats)
(div :class "flex flex-wrap gap-2 mb-6 text-xs"
(span :class "bg-stone-100 text-stone-600 px-2 py-0.5 rounded font-medium"
(str (get stats "total-defines") " defines"))
(when (> (get stats "pure-count") 0)
(span :class "bg-green-100 text-green-700 px-2 py-0.5 rounded"
(str (get stats "pure-count") " pure")))
(when (> (get stats "mutation-count") 0)
(span :class "bg-amber-100 text-amber-700 px-2 py-0.5 rounded"
(str (get stats "mutation-count") " mutation")))
(when (> (get stats "io-count") 0)
(span :class "bg-orange-100 text-orange-700 px-2 py-0.5 rounded"
(str (get stats "io-count") " io")))
(when (> (get stats "render-count") 0)
(span :class "bg-sky-100 text-sky-700 px-2 py-0.5 rounded"
(str (get stats "render-count") " render")))
(when (> (get stats "test-total") 0)
(span :class "bg-violet-100 text-violet-700 px-2 py-0.5 rounded"
(str (get stats "test-total") " tests")))
(span :class "bg-stone-100 text-stone-500 px-2 py-0.5 rounded"
(str (get stats "lines") " lines"))))
;; ---------------------------------------------------------------------------
;; Section
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-explorer-section (&key section)
(div :class "mb-8"
(h2 :class "text-lg font-semibold text-stone-700 border-b border-stone-200 pb-1 mb-3"
:id (replace (lower (get section "title")) " " "-")
(get section "title"))
(when (get section "comment")
(p :class "text-sm text-stone-500 mb-3" (get section "comment")))
(div :class "space-y-4"
(map (fn (d) (~specs-explorer/spec-explorer-define :d d))
(get section "defines")))))
;; ---------------------------------------------------------------------------
;; Define card — one function/constant with all five rings
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-explorer-define (&key d)
(div :class "rounded border border-stone-200 p-4"
:id (str "fn-" (get d "name"))
;; Name + effect badges
(div :class "flex items-center gap-2 flex-wrap"
(span :class "font-mono font-semibold text-stone-800" (get d "name"))
(span :class "text-xs text-stone-400" (get d "kind"))
(if (empty? (get d "effects"))
(span :class "text-xs px-1.5 py-0.5 rounded bg-green-100 text-green-700" "pure")
(map (fn (eff) (~specs-explorer/spec-effect-badge :effect eff))
(get d "effects"))))
;; Params
(when (not (empty? (get d "params")))
(~specs-explorer/spec-param-list :params (get d "params")))
;; Ring 2: Translation panels (SX + Python + JavaScript + Z3)
(~specs-explorer/spec-ring-translations
:source (get d "source")
:python (get d "python")
:javascript (get d "javascript")
:z3 (get d "z3"))
;; Ring 3: Cross-references
(when (not (empty? (get d "refs")))
(~specs-explorer/spec-ring-bridge :refs (get d "refs")))
;; Ring 4: Tests
(when (> (get d "test-count") 0)
(~specs-explorer/spec-ring-runtime
:tests (get d "tests")
:test-count (get d "test-count")))))
;; ---------------------------------------------------------------------------
;; Effect badge
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-effect-badge (&key effect)
(span :class (str "text-xs px-1.5 py-0.5 rounded "
(case effect
"mutation" "bg-amber-100 text-amber-700"
"io" "bg-orange-100 text-orange-700"
"render" "bg-sky-100 text-sky-700"
:else "bg-stone-100 text-stone-500"))
effect))
;; ---------------------------------------------------------------------------
;; Param list
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-param-list (&key params)
(div :class "mt-1 flex flex-wrap gap-1"
(map (fn (p)
(let ((name (get p "name"))
(typ (get p "type")))
(if (or (= name "&rest") (= name "&key"))
(span :class "text-xs font-mono text-violet-500" name)
(span :class "text-xs font-mono px-1 py-0.5 rounded bg-stone-50 border border-stone-200"
(if typ
(<> (span :class "text-stone-700" name)
(span :class "text-stone-400" " : ")
(span :class "text-violet-600" typ))
(span :class "text-stone-700" name))))))
params)))
;; ---------------------------------------------------------------------------
;; Ring 2: Translation panels (nucleus + bootstrapper)
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-ring-translations (&key source python javascript z3)
(when (not (= source ""))
(div :class "mt-3 border border-stone-200 rounded-lg overflow-hidden"
;; SX source — Ring 1: the nucleus (always open)
(details :open "true"
(summary :class "px-3 py-1.5 bg-stone-50 text-xs font-medium text-stone-600 cursor-pointer"
"SX")
(pre :class "text-xs p-3 overflow-x-auto bg-white"
(code (highlight source "sx"))))
;; Python — Ring 2: bootstrapper
(when python
(details
(summary :class "px-3 py-1.5 bg-stone-50 text-xs font-medium text-stone-600 cursor-pointer border-t border-stone-200"
"Python")
(pre :class "text-xs p-3 overflow-x-auto bg-white"
(code (highlight python "python")))))
;; JavaScript — Ring 2: bootstrapper
(when javascript
(details
(summary :class "px-3 py-1.5 bg-stone-50 text-xs font-medium text-stone-600 cursor-pointer border-t border-stone-200"
"JavaScript")
(pre :class "text-xs p-3 overflow-x-auto bg-white"
(code (highlight javascript "javascript")))))
;; Z3 / SMT-LIB — Ring 2: formal translation
(when z3
(details
(summary :class "px-3 py-1.5 bg-stone-50 text-xs font-medium text-stone-600 cursor-pointer border-t border-stone-200"
"Z3 / SMT-LIB")
(pre :class "text-xs p-3 overflow-x-auto bg-white"
(code (highlight z3 "lisp"))))))))
;; ---------------------------------------------------------------------------
;; Ring 3: Cross-references (bridge)
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-ring-bridge (&key refs)
(div :class "mt-2"
(span :class "text-xs font-medium text-stone-500" "References")
(div :class "flex flex-wrap gap-1 mt-1"
(map (fn (ref)
(a :href (str "#fn-" ref)
:class "text-xs px-1.5 py-0.5 rounded bg-stone-100 text-stone-600 font-mono hover:bg-stone-200"
ref))
refs))))
;; ---------------------------------------------------------------------------
;; Ring 4: Tests (runtime)
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-ring-runtime (&key tests test-count)
(div :class "mt-2"
(div :class "flex items-center gap-1"
(span :class "text-xs font-medium text-stone-500" "Tests")
(span :class "text-xs px-1.5 py-0.5 rounded bg-violet-100 text-violet-700"
(str test-count)))
(ul :class "mt-1 text-xs text-stone-500 list-none"
(map (fn (t)
(li :class "flex items-center gap-1"
(span :class "text-green-500 text-xs" "●")
(get t "name")))
tests))))
;; ---------------------------------------------------------------------------
;; Platform interface table (Ring 3 overview)
;; ---------------------------------------------------------------------------
(defcomp ~specs-explorer/spec-platform-interface (&key items)
(div :class "mt-8"
(h2 :class "text-lg font-semibold text-stone-700 border-b border-stone-200 pb-1 mb-3"
"Platform Interface")
(p :class "text-sm text-stone-500 mb-3"
"Functions the host platform must provide.")
(div :class "overflow-x-auto rounded border border-stone-200"
(table :class "w-full text-left text-sm"
(thead (tr :class "border-b border-stone-200 bg-stone-50"
(th :class "px-3 py-2 font-medium text-stone-600" "Name")
(th :class "px-3 py-2 font-medium text-stone-600" "Params")
(th :class "px-3 py-2 font-medium text-stone-600" "Returns")
(th :class "px-3 py-2 font-medium text-stone-600" "Description")))
(tbody
(map (fn (item)
(tr :class "border-b border-stone-100"
(td :class "px-3 py-2 font-mono text-sm text-violet-700" (get item "name"))
(td :class "px-3 py-2 font-mono text-xs text-stone-500" (get item "params"))
(td :class "px-3 py-2 font-mono text-xs text-stone-500" (get item "returns"))
(td :class "px-3 py-2 text-stone-600" (get item "doc"))))
items))))))
Reference in New Issue View Git Blame Copy Permalink