giles
1341c144da
- Rename /reactive-islands/ → /reactive/, /reference/ → /hypermedia/reference/, /examples/ → /hypermedia/examples/ across all .sx and .py files - Add 404 error page (not-found.sx) working on both server refresh and client-side SX navigation via orchestration.sx error response handling - Add trailing slash redirect (GET only, excludes /api/, /static/, /internal/) - Remove blue sky-500 header bar from SX docs layout (conditional on header-rows) - Fix 405 on API endpoints from trailing slash redirect hitting POST/PUT/DELETE - Fix client-side 404: orchestration.sx now swaps error response content instead of silently dropping it - Add new plan files and home page component Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
329 lines
12 KiB
Plaintext
329 lines
12 KiB
Plaintext
;; ==========================================================================
|
|
;; adapter-sx.sx — SX wire format rendering adapter
|
|
;;
|
|
;; Serializes SX expressions for client-side rendering.
|
|
;; Component calls are NOT expanded — they're sent to the client as-is.
|
|
;; HTML tags are serialized as SX source text. Special forms are evaluated.
|
|
;;
|
|
;; Depends on:
|
|
;; render.sx — HTML_TAGS
|
|
;; eval.sx — eval-expr, trampoline, call-lambda, expand-macro
|
|
;; ==========================================================================
|
|
|
|
|
|
(define render-to-sx
|
|
(fn (expr env)
|
|
(let ((result (aser expr env)))
|
|
;; aser-call already returns serialized SX strings;
|
|
;; only serialize non-string values
|
|
(if (= (type-of result) "string")
|
|
result
|
|
(serialize result)))))
|
|
|
|
(define aser
|
|
(fn (expr env)
|
|
;; Evaluate for SX wire format — serialize rendering forms,
|
|
;; evaluate control flow and function calls.
|
|
(case (type-of expr)
|
|
"number" expr
|
|
"string" expr
|
|
"boolean" expr
|
|
"nil" nil
|
|
|
|
"symbol"
|
|
(let ((name (symbol-name expr)))
|
|
(cond
|
|
(env-has? env name) (env-get env name)
|
|
(primitive? name) (get-primitive name)
|
|
(= name "true") true
|
|
(= name "false") false
|
|
(= name "nil") nil
|
|
:else (error (str "Undefined symbol: " name))))
|
|
|
|
"keyword" (keyword-name expr)
|
|
|
|
"list"
|
|
(if (empty? expr)
|
|
(list)
|
|
(aser-list expr env))
|
|
|
|
:else expr)))
|
|
|
|
|
|
(define aser-list
|
|
(fn (expr env)
|
|
(let ((head (first expr))
|
|
(args (rest expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
(map (fn (x) (aser x env)) expr)
|
|
(let ((name (symbol-name head)))
|
|
(cond
|
|
;; Fragment — serialize children
|
|
(= name "<>")
|
|
(aser-fragment args env)
|
|
|
|
;; Component call — serialize WITHOUT expanding
|
|
(starts-with? name "~")
|
|
(aser-call name args env)
|
|
|
|
;; Lake — serialize (server-morphable slot)
|
|
(= name "lake")
|
|
(aser-call name args env)
|
|
|
|
;; Marsh — serialize (reactive server-morphable slot)
|
|
(= name "marsh")
|
|
(aser-call name args env)
|
|
|
|
;; HTML tag — serialize
|
|
(contains? HTML_TAGS name)
|
|
(aser-call name args env)
|
|
|
|
;; Special/HO forms — evaluate (produces data)
|
|
(or (special-form? name) (ho-form? name))
|
|
(aser-special name expr env)
|
|
|
|
;; Macro — expand then aser
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(aser (expand-macro (env-get env name) args env) env)
|
|
|
|
;; Function call — evaluate fully
|
|
:else
|
|
(let ((f (trampoline (eval-expr head env)))
|
|
(evaled-args (map (fn (a) (trampoline (eval-expr a env))) args)))
|
|
(cond
|
|
(and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
|
|
(apply f evaled-args)
|
|
(lambda? f)
|
|
(trampoline (call-lambda f evaled-args env))
|
|
(component? f)
|
|
(aser-call (str "~" (component-name f)) args env)
|
|
(island? f)
|
|
(aser-call (str "~" (component-name f)) args env)
|
|
:else (error (str "Not callable: " (inspect f)))))))))))
|
|
|
|
|
|
(define aser-fragment
|
|
(fn (children env)
|
|
;; Serialize (<> child1 child2 ...) to sx source string
|
|
(let ((parts (filter
|
|
(fn (x) (not (nil? x)))
|
|
(map (fn (c) (aser c env)) children))))
|
|
(if (empty? parts)
|
|
""
|
|
(str "(<> " (join " " (map serialize parts)) ")")))))
|
|
|
|
|
|
(define aser-call
|
|
(fn (name args env)
|
|
;; Serialize (name :key val child ...) — evaluate args but keep as sx
|
|
(let ((parts (list name)))
|
|
(reduce
|
|
(fn (state arg)
|
|
(let ((skip (get state "skip")))
|
|
(if skip
|
|
(assoc state "skip" false "i" (inc (get state "i")))
|
|
(if (and (= (type-of arg) "keyword")
|
|
(< (inc (get state "i")) (len args)))
|
|
(let ((val (aser (nth args (inc (get state "i"))) env)))
|
|
(when (not (nil? val))
|
|
(append! parts (str ":" (keyword-name arg)))
|
|
(append! parts (serialize val)))
|
|
(assoc state "skip" true "i" (inc (get state "i"))))
|
|
(let ((val (aser arg env)))
|
|
(when (not (nil? val))
|
|
(append! parts (serialize val)))
|
|
(assoc state "i" (inc (get state "i"))))))))
|
|
(dict "i" 0 "skip" false)
|
|
args)
|
|
(str "(" (join " " parts) ")"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Form classification
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define SPECIAL_FORM_NAMES
|
|
(list "if" "when" "cond" "case" "and" "or"
|
|
"let" "let*" "lambda" "fn"
|
|
"define" "defcomp" "defmacro" "defstyle"
|
|
"defhandler" "defpage" "defquery" "defaction" "defrelation"
|
|
"begin" "do" "quote" "quasiquote"
|
|
"->" "set!" "letrec" "dynamic-wind" "defisland"))
|
|
|
|
(define HO_FORM_NAMES
|
|
(list "map" "map-indexed" "filter" "reduce"
|
|
"some" "every?" "for-each"))
|
|
|
|
(define special-form?
|
|
(fn (name)
|
|
(contains? SPECIAL_FORM_NAMES name)))
|
|
|
|
(define ho-form?
|
|
(fn (name)
|
|
(contains? HO_FORM_NAMES name)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; aser-special — evaluate special/HO forms in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Control flow forms evaluate conditions normally but render branches
|
|
;; through aser (serializing tags/components instead of rendering HTML).
|
|
;; Definition forms evaluate for side effects and return nil.
|
|
|
|
(define aser-special
|
|
(fn (name expr env)
|
|
(let ((args (rest expr)))
|
|
(cond
|
|
;; if — evaluate condition, aser chosen branch
|
|
(= name "if")
|
|
(if (trampoline (eval-expr (first args) env))
|
|
(aser (nth args 1) env)
|
|
(if (> (len args) 2)
|
|
(aser (nth args 2) env)
|
|
nil))
|
|
|
|
;; when — evaluate condition, aser body if true
|
|
(= name "when")
|
|
(if (not (trampoline (eval-expr (first args) env)))
|
|
nil
|
|
(let ((result nil))
|
|
(for-each (fn (body) (set! result (aser body env)))
|
|
(rest args))
|
|
result))
|
|
|
|
;; cond — evaluate conditions, aser matching branch
|
|
(= name "cond")
|
|
(let ((branch (eval-cond args env)))
|
|
(if branch (aser branch env) nil))
|
|
|
|
;; case — evaluate match value, check each pair
|
|
(= name "case")
|
|
(let ((match-val (trampoline (eval-expr (first args) env)))
|
|
(clauses (rest args)))
|
|
(eval-case-aser match-val clauses env))
|
|
|
|
;; let / let*
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (process-bindings (first args) env))
|
|
(result nil))
|
|
(for-each (fn (body) (set! result (aser body local)))
|
|
(rest args))
|
|
result)
|
|
|
|
;; begin / do
|
|
(or (= name "begin") (= name "do"))
|
|
(let ((result nil))
|
|
(for-each (fn (body) (set! result (aser body env))) args)
|
|
result)
|
|
|
|
;; and — short-circuit
|
|
(= name "and")
|
|
(let ((result true))
|
|
(some (fn (arg)
|
|
(set! result (trampoline (eval-expr arg env)))
|
|
(not result))
|
|
args)
|
|
result)
|
|
|
|
;; or — short-circuit
|
|
(= name "or")
|
|
(let ((result false))
|
|
(some (fn (arg)
|
|
(set! result (trampoline (eval-expr arg env)))
|
|
result)
|
|
args)
|
|
result)
|
|
|
|
;; map — evaluate function and collection, map through aser
|
|
(= name "map")
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map (fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-set! local (first (lambda-params f)) item)
|
|
(aser (lambda-body f) local))
|
|
(invoke f item)))
|
|
coll))
|
|
|
|
;; map-indexed
|
|
(= name "map-indexed")
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map-indexed (fn (i item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-set! local (first (lambda-params f)) i)
|
|
(env-set! local (nth (lambda-params f) 1) item)
|
|
(aser (lambda-body f) local))
|
|
(invoke f i item)))
|
|
coll))
|
|
|
|
;; for-each — evaluate for side effects, aser each body
|
|
(= name "for-each")
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env)))
|
|
(results (list)))
|
|
(for-each (fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-set! local (first (lambda-params f)) item)
|
|
(append! results (aser (lambda-body f) local)))
|
|
(invoke f item)))
|
|
coll)
|
|
(if (empty? results) nil results))
|
|
|
|
;; defisland — evaluate AND serialize (client needs the definition)
|
|
(= name "defisland")
|
|
(do (trampoline (eval-expr expr env))
|
|
(serialize expr))
|
|
|
|
;; Definition forms — evaluate for side effects
|
|
(or (= name "define") (= name "defcomp") (= name "defmacro")
|
|
(= name "defstyle") (= name "defhandler") (= name "defpage")
|
|
(= name "defquery") (= name "defaction") (= name "defrelation"))
|
|
(do (trampoline (eval-expr expr env)) nil)
|
|
|
|
;; Everything else — evaluate normally
|
|
:else
|
|
(trampoline (eval-expr expr env))))))
|
|
|
|
|
|
;; Helper: case dispatch for aser mode
|
|
(define eval-case-aser
|
|
(fn (match-val clauses env)
|
|
(if (< (len clauses) 2)
|
|
nil
|
|
(let ((test (first clauses))
|
|
(body (nth clauses 1)))
|
|
(if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
|
|
(and (= (type-of test) "symbol")
|
|
(or (= (symbol-name test) ":else")
|
|
(= (symbol-name test) "else"))))
|
|
(aser body env)
|
|
(if (= match-val (trampoline (eval-expr test env)))
|
|
(aser body env)
|
|
(eval-case-aser match-val (slice clauses 2) env)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — SX wire adapter
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; From eval.sx:
|
|
;; eval-expr, trampoline, call-lambda, expand-macro
|
|
;; env-has?, env-get, env-set!, env-merge, callable?, lambda?, component?,
|
|
;; macro?, island?, primitive?, get-primitive, component-name
|
|
;; lambda-closure, lambda-params, lambda-body
|
|
;;
|
|
;; From render.sx:
|
|
;; HTML_TAGS, eval-cond, process-bindings
|
|
;;
|
|
;; From parser.sx:
|
|
;; serialize (= sx-serialize)
|
|
;;
|
|
;; From signals.sx (optional):
|
|
;; invoke
|
|
;; --------------------------------------------------------------------------
|