Compare commits
27 Commits
8f88e52b27
...
33586024a7
| Author | SHA1 | Date | |
|---|---|---|---|
| 33586024a7 | |||
| 1fce4970fb | |||
| 17c58a2b5b | |||
| c23d0888ea | |||
| 95e42f9a87 | |||
| 1b6612fd08 | |||
| 00cf6bbd75 | |||
| 6a68894f7d | |||
| ac72a4de8d | |||
| 2dc13ab34f | |||
| 7515634901 | |||
| c5a4340293 | |||
| 365440d42f | |||
| fe36877c71 | |||
| 4aa2133b39 | |||
| c2d9a3d2b1 | |||
| 575d100f67 | |||
| 56f49f29fb | |||
| e046542aa0 | |||
| 89e8645d8f | |||
| fba84540e2 | |||
| 4e96997e09 | |||
| 2f42e8826c | |||
| 524c99e4ff | |||
| 0f9b449315 | |||
| a69604acaf | |||
| ce7ad125b6 |
@@ -14,7 +14,7 @@
|
||||
// =========================================================================
|
||||
|
||||
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
|
||||
var SX_VERSION = "2026-03-11T21:11:04Z";
|
||||
var SX_VERSION = "2026-03-11T23:22:03Z";
|
||||
|
||||
function isNil(x) { return x === NIL || x === null || x === undefined; }
|
||||
function isSxTruthy(x) { return x !== false && !isNil(x); }
|
||||
@@ -729,10 +729,10 @@
|
||||
var args = rest(expr);
|
||||
return (isSxTruthy(!isSxTruthy(sxOr((typeOf(head) == "symbol"), (typeOf(head) == "lambda"), (typeOf(head) == "list")))) ? map(function(x) { return trampoline(evalExpr(x, env)); }, expr) : (isSxTruthy((typeOf(head) == "symbol")) ? (function() {
|
||||
var name = symbolName(head);
|
||||
return (isSxTruthy((name == "if")) ? sfIf(args, env) : (isSxTruthy((name == "when")) ? sfWhen(args, env) : (isSxTruthy((name == "cond")) ? sfCond(args, env) : (isSxTruthy((name == "case")) ? sfCase(args, env) : (isSxTruthy((name == "and")) ? sfAnd(args, env) : (isSxTruthy((name == "or")) ? sfOr(args, env) : (isSxTruthy((name == "let")) ? sfLet(args, env) : (isSxTruthy((name == "let*")) ? sfLet(args, env) : (isSxTruthy((name == "letrec")) ? sfLetrec(args, env) : (isSxTruthy((name == "lambda")) ? sfLambda(args, env) : (isSxTruthy((name == "fn")) ? sfLambda(args, env) : (isSxTruthy((name == "define")) ? sfDefine(args, env) : (isSxTruthy((name == "defcomp")) ? sfDefcomp(args, env) : (isSxTruthy((name == "defisland")) ? sfDefisland(args, env) : (isSxTruthy((name == "defmacro")) ? sfDefmacro(args, env) : (isSxTruthy((name == "defstyle")) ? sfDefstyle(args, env) : (isSxTruthy((name == "defhandler")) ? sfDefhandler(args, env) : (isSxTruthy((name == "defpage")) ? sfDefpage(args, env) : (isSxTruthy((name == "defquery")) ? sfDefquery(args, env) : (isSxTruthy((name == "defaction")) ? sfDefaction(args, env) : (isSxTruthy((name == "begin")) ? sfBegin(args, env) : (isSxTruthy((name == "do")) ? sfBegin(args, env) : (isSxTruthy((name == "quote")) ? sfQuote(args, env) : (isSxTruthy((name == "quasiquote")) ? sfQuasiquote(args, env) : (isSxTruthy((name == "->")) ? sfThreadFirst(args, env) : (isSxTruthy((name == "set!")) ? sfSetBang(args, env) : (isSxTruthy((name == "reset")) ? sfReset(args, env) : (isSxTruthy((name == "shift")) ? sfShift(args, env) : (isSxTruthy((name == "dynamic-wind")) ? sfDynamicWind(args, env) : (isSxTruthy((name == "map")) ? hoMap(args, env) : (isSxTruthy((name == "map-indexed")) ? hoMapIndexed(args, env) : (isSxTruthy((name == "filter")) ? hoFilter(args, env) : (isSxTruthy((name == "reduce")) ? hoReduce(args, env) : (isSxTruthy((name == "some")) ? hoSome(args, env) : (isSxTruthy((name == "every?")) ? hoEvery(args, env) : (isSxTruthy((name == "for-each")) ? hoForEach(args, env) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
|
||||
return (isSxTruthy((name == "if")) ? sfIf(args, env) : (isSxTruthy((name == "when")) ? sfWhen(args, env) : (isSxTruthy((name == "cond")) ? sfCond(args, env) : (isSxTruthy((name == "case")) ? sfCase(args, env) : (isSxTruthy((name == "and")) ? sfAnd(args, env) : (isSxTruthy((name == "or")) ? sfOr(args, env) : (isSxTruthy((name == "let")) ? sfLet(args, env) : (isSxTruthy((name == "let*")) ? sfLet(args, env) : (isSxTruthy((name == "letrec")) ? sfLetrec(args, env) : (isSxTruthy((name == "lambda")) ? sfLambda(args, env) : (isSxTruthy((name == "fn")) ? sfLambda(args, env) : (isSxTruthy((name == "define")) ? sfDefine(args, env) : (isSxTruthy((name == "defcomp")) ? sfDefcomp(args, env) : (isSxTruthy((name == "defisland")) ? sfDefisland(args, env) : (isSxTruthy((name == "defmacro")) ? sfDefmacro(args, env) : (isSxTruthy((name == "defstyle")) ? sfDefstyle(args, env) : (isSxTruthy((name == "defhandler")) ? sfDefhandler(args, env) : (isSxTruthy((name == "defpage")) ? sfDefpage(args, env) : (isSxTruthy((name == "defquery")) ? sfDefquery(args, env) : (isSxTruthy((name == "defaction")) ? sfDefaction(args, env) : (isSxTruthy((name == "deftype")) ? sfDeftype(args, env) : (isSxTruthy((name == "defeffect")) ? sfDefeffect(args, env) : (isSxTruthy((name == "begin")) ? sfBegin(args, env) : (isSxTruthy((name == "do")) ? sfBegin(args, env) : (isSxTruthy((name == "quote")) ? sfQuote(args, env) : (isSxTruthy((name == "quasiquote")) ? sfQuasiquote(args, env) : (isSxTruthy((name == "->")) ? sfThreadFirst(args, env) : (isSxTruthy((name == "set!")) ? sfSetBang(args, env) : (isSxTruthy((name == "reset")) ? sfReset(args, env) : (isSxTruthy((name == "shift")) ? sfShift(args, env) : (isSxTruthy((name == "dynamic-wind")) ? sfDynamicWind(args, env) : (isSxTruthy((name == "map")) ? hoMap(args, env) : (isSxTruthy((name == "map-indexed")) ? hoMapIndexed(args, env) : (isSxTruthy((name == "filter")) ? hoFilter(args, env) : (isSxTruthy((name == "reduce")) ? hoReduce(args, env) : (isSxTruthy((name == "some")) ? hoSome(args, env) : (isSxTruthy((name == "every?")) ? hoEvery(args, env) : (isSxTruthy((name == "for-each")) ? hoForEach(args, env) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
|
||||
var mac = envGet(env, name);
|
||||
return makeThunk(expandMacro(mac, args, env), env);
|
||||
})() : (isSxTruthy((isSxTruthy(renderActiveP()) && isRenderExpr(expr))) ? renderExpr(expr, env) : evalCall(head, args, env)))))))))))))))))))))))))))))))))))))));
|
||||
})() : (isSxTruthy((isSxTruthy(renderActiveP()) && isRenderExpr(expr))) ? renderExpr(expr, env) : evalCall(head, args, env)))))))))))))))))))))))))))))))))))))))));
|
||||
})() : evalCall(head, args, env)));
|
||||
})(); };
|
||||
|
||||
@@ -888,11 +888,22 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
// sf-define
|
||||
var sfDefine = function(args, env) { return (function() {
|
||||
var nameSym = first(args);
|
||||
var value = trampoline(evalExpr(nth(args, 1), env));
|
||||
var hasEffects = (isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects"));
|
||||
var valIdx = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects"))) ? 3 : 1);
|
||||
var value = trampoline(evalExpr(nth(args, valIdx), env));
|
||||
if (isSxTruthy((isSxTruthy(isLambda(value)) && isNil(lambdaName(value))))) {
|
||||
value.name = symbolName(nameSym);
|
||||
}
|
||||
envSet(env, symbolName(nameSym), value);
|
||||
if (isSxTruthy(hasEffects)) {
|
||||
(function() {
|
||||
var effectsRaw = nth(args, 2);
|
||||
var effectList = (isSxTruthy((typeOf(effectsRaw) == "list")) ? map(function(e) { return (isSxTruthy((typeOf(e) == "symbol")) ? symbolName(e) : (String(e))); }, effectsRaw) : [(String(effectsRaw))]);
|
||||
var effectAnns = (isSxTruthy(envHas(env, "*effect-annotations*")) ? envGet(env, "*effect-annotations*") : {});
|
||||
effectAnns[symbolName(nameSym)] = effectList;
|
||||
return envSet(env, "*effect-annotations*", effectAnns);
|
||||
})();
|
||||
}
|
||||
return value;
|
||||
})(); };
|
||||
|
||||
@@ -909,8 +920,17 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var affinity = defcompKwarg(args, "affinity", "auto");
|
||||
return (function() {
|
||||
var comp = makeComponent(compName, params, hasChildren, body, env, affinity);
|
||||
var effects = defcompKwarg(args, "effects", NIL);
|
||||
if (isSxTruthy((isSxTruthy(!isSxTruthy(isNil(paramTypes))) && !isSxTruthy(isEmpty(keys(paramTypes)))))) {
|
||||
componentSetParamTypes_b(comp, paramTypes);
|
||||
}
|
||||
if (isSxTruthy(!isSxTruthy(isNil(effects)))) {
|
||||
(function() {
|
||||
var effectList = (isSxTruthy((typeOf(effects) == "list")) ? map(function(e) { return (isSxTruthy((typeOf(e) == "symbol")) ? symbolName(e) : (String(e))); }, effects) : [(String(effects))]);
|
||||
var effectAnns = (isSxTruthy(envHas(env, "*effect-annotations*")) ? envGet(env, "*effect-annotations*") : {});
|
||||
effectAnns[symbolName(nameSym)] = effectList;
|
||||
return envSet(env, "*effect-annotations*", effectAnns);
|
||||
})();
|
||||
}
|
||||
envSet(env, symbolName(nameSym), comp);
|
||||
return comp;
|
||||
@@ -997,6 +1017,45 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
return value;
|
||||
})(); };
|
||||
|
||||
// make-type-def
|
||||
var makeTypeDef = function(name, params, body) { return {"name": name, "params": params, "body": body}; };
|
||||
|
||||
// normalize-type-body
|
||||
var normalizeTypeBody = function(body) { return (isSxTruthy(isNil(body)) ? "nil" : (isSxTruthy((typeOf(body) == "symbol")) ? symbolName(body) : (isSxTruthy((typeOf(body) == "string")) ? body : (isSxTruthy((typeOf(body) == "keyword")) ? keywordName(body) : (isSxTruthy((typeOf(body) == "dict")) ? mapDict(function(k, v) { return normalizeTypeBody(v); }, body) : (isSxTruthy((typeOf(body) == "list")) ? (isSxTruthy(isEmpty(body)) ? "any" : (function() {
|
||||
var head = first(body);
|
||||
return (function() {
|
||||
var headName = (isSxTruthy((typeOf(head) == "symbol")) ? symbolName(head) : (String(head)));
|
||||
return (isSxTruthy((headName == "union")) ? cons("or", map(normalizeTypeBody, rest(body))) : cons(headName, map(normalizeTypeBody, rest(body))));
|
||||
})();
|
||||
})()) : (String(body)))))))); };
|
||||
|
||||
// sf-deftype
|
||||
var sfDeftype = function(args, env) { return (function() {
|
||||
var nameOrForm = first(args);
|
||||
var bodyExpr = nth(args, 1);
|
||||
var typeName = NIL;
|
||||
var typeParams = [];
|
||||
(isSxTruthy((typeOf(nameOrForm) == "symbol")) ? (typeName = symbolName(nameOrForm)) : (isSxTruthy((typeOf(nameOrForm) == "list")) ? ((typeName = symbolName(first(nameOrForm))), (typeParams = map(function(p) { return (isSxTruthy((typeOf(p) == "symbol")) ? symbolName(p) : (String(p))); }, rest(nameOrForm)))) : NIL));
|
||||
return (function() {
|
||||
var body = normalizeTypeBody(bodyExpr);
|
||||
var registry = (isSxTruthy(envHas(env, "*type-registry*")) ? envGet(env, "*type-registry*") : {});
|
||||
registry[typeName] = makeTypeDef(typeName, typeParams, body);
|
||||
envSet(env, "*type-registry*", registry);
|
||||
return NIL;
|
||||
})();
|
||||
})(); };
|
||||
|
||||
// sf-defeffect
|
||||
var sfDefeffect = function(args, env) { return (function() {
|
||||
var effectName = (isSxTruthy((typeOf(first(args)) == "symbol")) ? symbolName(first(args)) : (String(first(args))));
|
||||
var registry = (isSxTruthy(envHas(env, "*effect-registry*")) ? envGet(env, "*effect-registry*") : []);
|
||||
if (isSxTruthy(!isSxTruthy(contains(registry, effectName)))) {
|
||||
registry.push(effectName);
|
||||
}
|
||||
envSet(env, "*effect-registry*", registry);
|
||||
return NIL;
|
||||
})(); };
|
||||
|
||||
// sf-begin
|
||||
var sfBegin = function(args, env) { return (isSxTruthy(isEmpty(args)) ? NIL : (forEach(function(e) { return trampoline(evalExpr(e, env)); }, slice(args, 0, (len(args) - 1))), makeThunk(last(args), env))); };
|
||||
|
||||
@@ -1156,7 +1215,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var BOOLEAN_ATTRS = ["async", "autofocus", "autoplay", "checked", "controls", "default", "defer", "disabled", "formnovalidate", "hidden", "inert", "ismap", "loop", "multiple", "muted", "nomodule", "novalidate", "open", "playsinline", "readonly", "required", "reversed", "selected"];
|
||||
|
||||
// definition-form?
|
||||
var isDefinitionForm = function(name) { return sxOr((name == "define"), (name == "defcomp"), (name == "defisland"), (name == "defmacro"), (name == "defstyle"), (name == "defhandler")); };
|
||||
var isDefinitionForm = function(name) { return sxOr((name == "define"), (name == "defcomp"), (name == "defisland"), (name == "defmacro"), (name == "defstyle"), (name == "defhandler"), (name == "deftype"), (name == "defeffect")); };
|
||||
|
||||
// parse-element-args
|
||||
var parseElementArgs = function(args, env) { return (function() {
|
||||
@@ -1366,7 +1425,7 @@ return (function() { var _m = typeOf(expr); if (_m == "nil") return ""; if (_m =
|
||||
var renderValueToHtml = function(val, env) { return (function() { var _m = typeOf(val); if (_m == "nil") return ""; if (_m == "string") return escapeHtml(val); if (_m == "number") return (String(val)); if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "list") return renderListToHtml(val, env); if (_m == "raw-html") return rawHtmlContent(val); return escapeHtml((String(val))); })(); };
|
||||
|
||||
// RENDER_HTML_FORMS
|
||||
var RENDER_HTML_FORMS = ["if", "when", "cond", "case", "let", "let*", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "defhandler", "map", "map-indexed", "filter", "for-each"];
|
||||
var RENDER_HTML_FORMS = ["if", "when", "cond", "case", "let", "let*", "begin", "do", "define", "defcomp", "defisland", "defmacro", "defstyle", "defhandler", "deftype", "defeffect", "map", "map-indexed", "filter", "for-each"];
|
||||
|
||||
// render-html-form?
|
||||
var isRenderHtmlForm = function(name) { return contains(RENDER_HTML_FORMS, name); };
|
||||
@@ -1574,7 +1633,7 @@ return (function() { var _m = typeOf(expr); if (_m == "number") return expr; if
|
||||
})(); };
|
||||
|
||||
// SPECIAL_FORM_NAMES
|
||||
var SPECIAL_FORM_NAMES = ["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"];
|
||||
var SPECIAL_FORM_NAMES = ["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", "deftype", "defeffect"];
|
||||
|
||||
// HO_FORM_NAMES
|
||||
var HO_FORM_NAMES = ["map", "map-indexed", "filter", "reduce", "some", "every?", "for-each"];
|
||||
@@ -1645,7 +1704,7 @@ return result; }, args);
|
||||
return append_b(results, aser(lambdaBody(f), local));
|
||||
})() : invoke(f, item)); } }
|
||||
return (isSxTruthy(isEmpty(results)) ? NIL : results);
|
||||
})() : (isSxTruthy((name == "defisland")) ? (trampoline(evalExpr(expr, env)), serialize(expr)) : (isSxTruthy(sxOr((name == "define"), (name == "defcomp"), (name == "defmacro"), (name == "defstyle"), (name == "defhandler"), (name == "defpage"), (name == "defquery"), (name == "defaction"), (name == "defrelation"))) ? (trampoline(evalExpr(expr, env)), NIL) : trampoline(evalExpr(expr, env)))))))))))))));
|
||||
})() : (isSxTruthy((name == "defisland")) ? (trampoline(evalExpr(expr, env)), serialize(expr)) : (isSxTruthy(sxOr((name == "define"), (name == "defcomp"), (name == "defmacro"), (name == "defstyle"), (name == "defhandler"), (name == "defpage"), (name == "defquery"), (name == "defaction"), (name == "defrelation"), (name == "deftype"), (name == "defeffect"))) ? (trampoline(evalExpr(expr, env)), NIL) : trampoline(evalExpr(expr, env)))))))))))))));
|
||||
})(); };
|
||||
|
||||
// eval-case-aser
|
||||
@@ -3999,20 +4058,12 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
function domCallMethod() {
|
||||
var obj = arguments[0], method = arguments[1];
|
||||
var args = Array.prototype.slice.call(arguments, 2);
|
||||
console.log("[sx] dom-call-method:", obj, method, args);
|
||||
if (obj && typeof obj[method] === 'function') {
|
||||
try { return obj[method].apply(obj, args); }
|
||||
catch(e) { console.error("[sx] dom-call-method error:", e); return NIL; }
|
||||
}
|
||||
return NIL;
|
||||
}
|
||||
// Post a message to an iframe's contentWindow without exposing the cross-origin
|
||||
// Window object to the SX evaluator (which would trigger _thunk access errors).
|
||||
function domPostMessage(iframe, msg, origin) {
|
||||
try {
|
||||
if (iframe && iframe.contentWindow) {
|
||||
iframe.contentWindow.postMessage(msg, origin || '*');
|
||||
}
|
||||
} catch(e) { console.error("[sx] domPostMessage error:", e); }
|
||||
console.warn("[sx] dom-call-method: method not found or obj null", obj, method);
|
||||
return NIL;
|
||||
}
|
||||
|
||||
@@ -5221,7 +5272,6 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
PRIMITIVES["dom-get-prop"] = domGetProp;
|
||||
PRIMITIVES["dom-set-prop"] = domSetProp;
|
||||
PRIMITIVES["dom-call-method"] = domCallMethod;
|
||||
PRIMITIVES["dom-post-message"] = domPostMessage;
|
||||
PRIMITIVES["stop-propagation"] = stopPropagation_;
|
||||
PRIMITIVES["error-message"] = errorMessage;
|
||||
PRIMITIVES["schedule-idle"] = scheduleIdle;
|
||||
|
||||
@@ -215,6 +215,65 @@ def create_handler_blueprint(service_name: str) -> Any:
|
||||
return bp
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Public route registration — handlers with :path get mounted as routes
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
def register_route_handlers(app_or_bp: Any, service_name: str) -> int:
|
||||
"""Register public routes for all handlers with :path defined.
|
||||
|
||||
Returns the number of routes registered.
|
||||
"""
|
||||
from quart import Response, request
|
||||
from shared.browser.app.csrf import csrf_exempt
|
||||
|
||||
handlers = get_all_handlers(service_name)
|
||||
count = 0
|
||||
|
||||
for name, hdef in handlers.items():
|
||||
if not hdef.is_route:
|
||||
continue
|
||||
|
||||
# Capture hdef in closure
|
||||
_hdef = hdef
|
||||
|
||||
async def _route_view(_h=_hdef, **path_kwargs):
|
||||
from shared.sx.helpers import sx_response
|
||||
from shared.sx.primitives_io import reset_response_meta, get_response_meta
|
||||
reset_response_meta()
|
||||
args = dict(request.args)
|
||||
args.update(path_kwargs)
|
||||
result = await execute_handler(_h, service_name, args=args)
|
||||
resp = sx_response(result)
|
||||
meta = get_response_meta()
|
||||
if meta:
|
||||
if meta.get("status"):
|
||||
resp.status_code = meta["status"]
|
||||
for k, v in meta.get("headers", {}).items():
|
||||
resp.headers[k] = v
|
||||
return resp
|
||||
|
||||
endpoint = f"sx_route_{name}"
|
||||
view_fn = _route_view
|
||||
|
||||
if not _hdef.csrf:
|
||||
view_fn = csrf_exempt(view_fn)
|
||||
|
||||
method = _hdef.method.lower()
|
||||
route_reg = getattr(app_or_bp, method, None)
|
||||
if route_reg is None:
|
||||
logger.warning("Unsupported HTTP method %s for handler %s",
|
||||
_hdef.method, name)
|
||||
continue
|
||||
|
||||
route_reg(_hdef.path, endpoint=endpoint)(view_fn)
|
||||
logger.info("Registered route %s %s → handler:%s",
|
||||
_hdef.method.upper(), _hdef.path, name)
|
||||
count += 1
|
||||
|
||||
return count
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Direct app mount — replaces per-service fragment blueprint boilerplate
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
@@ -561,3 +561,15 @@ def prim_into(target: Any, coll: Any) -> Any:
|
||||
return result
|
||||
raise ValueError(f"into: unsupported target type {type(target).__name__}")
|
||||
|
||||
|
||||
@register_primitive("random-int")
|
||||
def prim_random_int(low: int, high: int) -> int:
|
||||
import random
|
||||
return random.randint(int(low), int(high))
|
||||
|
||||
|
||||
@register_primitive("json-encode")
|
||||
def prim_json_encode(value) -> str:
|
||||
import json
|
||||
return json.dumps(value, indent=2)
|
||||
|
||||
|
||||
@@ -46,6 +46,13 @@ _handler_service: contextvars.ContextVar[Any] = contextvars.ContextVar(
|
||||
"_handler_service", default=None
|
||||
)
|
||||
|
||||
_response_meta: contextvars.ContextVar[dict | None] = contextvars.ContextVar(
|
||||
"_response_meta", default=None
|
||||
)
|
||||
|
||||
# Ephemeral per-process state — resets on restart. For demos/testing only.
|
||||
_ephemeral_state: dict[str, Any] = {}
|
||||
|
||||
|
||||
def set_handler_service(service_obj: Any) -> None:
|
||||
"""Bind the local domain service for ``(service ...)`` primitive calls."""
|
||||
@@ -57,6 +64,16 @@ def get_handler_service() -> Any:
|
||||
return _handler_service.get(None)
|
||||
|
||||
|
||||
def reset_response_meta() -> None:
|
||||
"""Reset response meta for a new request."""
|
||||
_response_meta.set(None)
|
||||
|
||||
|
||||
def get_response_meta() -> dict | None:
|
||||
"""Get response meta (headers/status) set by handler IO primitives."""
|
||||
return _response_meta.get(None)
|
||||
|
||||
|
||||
class RequestContext:
|
||||
"""Per-request context provided to I/O primitives."""
|
||||
__slots__ = ("user", "is_htmx", "extras")
|
||||
@@ -297,6 +314,192 @@ async def _io_g(
|
||||
return getattr(g, key, None)
|
||||
|
||||
|
||||
@register_io_handler("now")
|
||||
async def _io_now(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> str:
|
||||
"""``(now)`` or ``(now "%H:%M:%S")`` → formatted timestamp string."""
|
||||
from datetime import datetime
|
||||
fmt = str(args[0]) if args else None
|
||||
dt = datetime.now()
|
||||
return dt.strftime(fmt) if fmt else dt.isoformat()
|
||||
|
||||
|
||||
@register_io_handler("sleep")
|
||||
async def _io_sleep(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(sleep 800)`` → pause for 800ms."""
|
||||
import asyncio
|
||||
from .types import NIL
|
||||
if not args:
|
||||
raise ValueError("sleep requires milliseconds")
|
||||
ms = int(args[0])
|
||||
await asyncio.sleep(ms / 1000.0)
|
||||
return NIL
|
||||
|
||||
|
||||
@register_io_handler("request-form")
|
||||
async def _io_request_form(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(request-form "name" default?)`` → read a form field."""
|
||||
if not args:
|
||||
raise ValueError("request-form requires a field name")
|
||||
from quart import request
|
||||
from .types import NIL
|
||||
name = str(args[0])
|
||||
default = args[1] if len(args) > 1 else NIL
|
||||
form = await request.form
|
||||
return form.get(name, default)
|
||||
|
||||
|
||||
@register_io_handler("request-json")
|
||||
async def _io_request_json(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(request-json)`` → JSON body as dict, or nil."""
|
||||
from quart import request
|
||||
from .types import NIL
|
||||
data = await request.get_json(silent=True)
|
||||
return data if data is not None else NIL
|
||||
|
||||
|
||||
@register_io_handler("request-header")
|
||||
async def _io_request_header(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(request-header "name" default?)`` → request header value."""
|
||||
if not args:
|
||||
raise ValueError("request-header requires a header name")
|
||||
from quart import request
|
||||
from .types import NIL
|
||||
name = str(args[0])
|
||||
default = args[1] if len(args) > 1 else NIL
|
||||
return request.headers.get(name, default)
|
||||
|
||||
|
||||
@register_io_handler("request-content-type")
|
||||
async def _io_request_content_type(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(request-content-type)`` → content-type string or nil."""
|
||||
from quart import request
|
||||
from .types import NIL
|
||||
return request.content_type or NIL
|
||||
|
||||
|
||||
@register_io_handler("request-args-all")
|
||||
async def _io_request_args_all(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> dict:
|
||||
"""``(request-args-all)`` → all query params as dict."""
|
||||
from quart import request
|
||||
return dict(request.args)
|
||||
|
||||
|
||||
@register_io_handler("request-form-all")
|
||||
async def _io_request_form_all(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> dict:
|
||||
"""``(request-form-all)`` → all form fields as dict."""
|
||||
from quart import request
|
||||
form = await request.form
|
||||
return dict(form)
|
||||
|
||||
|
||||
@register_io_handler("request-form-list")
|
||||
async def _io_request_form_list(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> list:
|
||||
"""``(request-form-list "field")`` → all values for a multi-value form field."""
|
||||
if not args:
|
||||
raise ValueError("request-form-list requires a field name")
|
||||
from quart import request
|
||||
form = await request.form
|
||||
return form.getlist(str(args[0]))
|
||||
|
||||
|
||||
@register_io_handler("request-headers-all")
|
||||
async def _io_request_headers_all(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> dict:
|
||||
"""``(request-headers-all)`` → all headers as dict (lowercase keys)."""
|
||||
from quart import request
|
||||
return {k.lower(): v for k, v in request.headers}
|
||||
|
||||
|
||||
@register_io_handler("request-file-name")
|
||||
async def _io_request_file_name(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(request-file-name "field")`` → filename or nil."""
|
||||
if not args:
|
||||
raise ValueError("request-file-name requires a field name")
|
||||
from quart import request
|
||||
from .types import NIL
|
||||
files = await request.files
|
||||
f = files.get(str(args[0]))
|
||||
return f.filename if f else NIL
|
||||
|
||||
|
||||
@register_io_handler("set-response-header")
|
||||
async def _io_set_response_header(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(set-response-header "Name" "value")`` → set on response after handler."""
|
||||
if len(args) < 2:
|
||||
raise ValueError("set-response-header requires name and value")
|
||||
from .types import NIL
|
||||
meta = _response_meta.get(None)
|
||||
if meta is None:
|
||||
meta = {"headers": {}, "status": None}
|
||||
_response_meta.set(meta)
|
||||
meta["headers"][str(args[0])] = str(args[1])
|
||||
return NIL
|
||||
|
||||
|
||||
@register_io_handler("set-response-status")
|
||||
async def _io_set_response_status(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(set-response-status 503)`` → set status code on response."""
|
||||
if not args:
|
||||
raise ValueError("set-response-status requires a status code")
|
||||
from .types import NIL
|
||||
meta = _response_meta.get(None)
|
||||
if meta is None:
|
||||
meta = {"headers": {}, "status": None}
|
||||
_response_meta.set(meta)
|
||||
meta["status"] = int(args[0])
|
||||
return NIL
|
||||
|
||||
|
||||
@register_io_handler("state-get")
|
||||
async def _io_state_get(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(state-get "key" default?)`` → read from ephemeral state."""
|
||||
if not args:
|
||||
raise ValueError("state-get requires a key")
|
||||
from .types import NIL
|
||||
key = str(args[0])
|
||||
default = args[1] if len(args) > 1 else NIL
|
||||
return _ephemeral_state.get(key, default)
|
||||
|
||||
|
||||
@register_io_handler("state-set!")
|
||||
async def _io_state_set(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
) -> Any:
|
||||
"""``(state-set! "key" value)`` → write to ephemeral state."""
|
||||
if len(args) < 2:
|
||||
raise ValueError("state-set! requires key and value")
|
||||
from .types import NIL
|
||||
_ephemeral_state[str(args[0])] = args[1]
|
||||
return NIL
|
||||
|
||||
|
||||
@register_io_handler("csrf-token")
|
||||
async def _io_csrf_token(
|
||||
args: list[Any], kwargs: dict[str, Any], ctx: RequestContext
|
||||
|
||||
@@ -40,7 +40,7 @@
|
||||
;; Async HTML renderer
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render
|
||||
(define-async async-render :effects [render io]
|
||||
(fn (expr (env :as dict) ctx)
|
||||
(case (type-of expr)
|
||||
"nil" ""
|
||||
@@ -56,7 +56,7 @@
|
||||
:else (escape-html (str expr)))))
|
||||
|
||||
|
||||
(define-async async-render-list
|
||||
(define-async async-render-list :effects [render io]
|
||||
(fn (expr (env :as dict) ctx)
|
||||
(let ((head (first expr)))
|
||||
(if (not (= (type-of head) "symbol"))
|
||||
@@ -138,7 +138,7 @@
|
||||
;; async-render-raw — handle (raw! ...) in async context
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-raw
|
||||
(define-async async-render-raw :effects [render io]
|
||||
(fn ((args :as list) (env :as dict) ctx)
|
||||
(let ((parts (list)))
|
||||
(for-each
|
||||
@@ -157,7 +157,7 @@
|
||||
;; async-render-element — render an HTML element with async arg evaluation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-element
|
||||
(define-async async-render-element :effects [render io]
|
||||
(fn ((tag :as string) (args :as list) (env :as dict) ctx)
|
||||
(let ((attrs (dict))
|
||||
(children (list)))
|
||||
@@ -185,7 +185,7 @@
|
||||
;; Uses for-each + mutable state instead of reduce, because the bootstrapper
|
||||
;; compiles inline for-each lambdas as for loops (which can contain await).
|
||||
|
||||
(define-async async-parse-element-args
|
||||
(define-async async-parse-element-args :effects [render io]
|
||||
(fn ((args :as list) (attrs :as dict) (children :as list) (env :as dict) ctx)
|
||||
(let ((skip false)
|
||||
(i 0))
|
||||
@@ -210,7 +210,7 @@
|
||||
;; async-render-component — expand and render a component asynchronously
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-component
|
||||
(define-async async-render-component :effects [render io]
|
||||
(fn ((comp :as component) (args :as list) (env :as dict) ctx)
|
||||
(let ((kwargs (dict))
|
||||
(children (list)))
|
||||
@@ -232,7 +232,7 @@
|
||||
;; async-render-island — SSR render of reactive island with hydration markers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-island
|
||||
(define-async async-render-island :effects [render io]
|
||||
(fn ((island :as island) (args :as list) (env :as dict) ctx)
|
||||
(let ((kwargs (dict))
|
||||
(children (list)))
|
||||
@@ -261,7 +261,7 @@
|
||||
;; async-render-lambda — render lambda body in HTML context
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-lambda
|
||||
(define-async async-render-lambda :effects [render io]
|
||||
(fn ((f :as lambda) (args :as list) (env :as dict) ctx)
|
||||
(let ((local (env-merge (lambda-closure f) env)))
|
||||
(for-each-indexed
|
||||
@@ -274,7 +274,7 @@
|
||||
;; async-parse-kw-args — parse keyword args and children with async eval
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-parse-kw-args
|
||||
(define-async async-parse-kw-args :effects [render io]
|
||||
(fn ((args :as list) (kwargs :as dict) (children :as list) (env :as dict) ctx)
|
||||
(let ((skip false)
|
||||
(i 0))
|
||||
@@ -300,7 +300,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Bootstrapper emits this as: [await async_render(x, env, ctx) for x in exprs]
|
||||
|
||||
(define-async async-map-render
|
||||
(define-async async-map-render :effects [render io]
|
||||
(fn ((exprs :as list) (env :as dict) ctx)
|
||||
(let ((results (list)))
|
||||
(for-each
|
||||
@@ -316,9 +316,10 @@
|
||||
(define ASYNC_RENDER_FORMS
|
||||
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
|
||||
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
|
||||
"deftype" "defeffect"
|
||||
"map" "map-indexed" "filter" "for-each"))
|
||||
|
||||
(define async-render-form?
|
||||
(define async-render-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(contains? ASYNC_RENDER_FORMS name)))
|
||||
|
||||
@@ -330,7 +331,7 @@
|
||||
;; Uses cond-scheme? from eval.sx (the FIXED version with every? check)
|
||||
;; and eval-cond from render.sx for correct scheme/clojure classification.
|
||||
|
||||
(define-async dispatch-async-render-form
|
||||
(define-async dispatch-async-render-form :effects [render io]
|
||||
(fn ((name :as string) expr (env :as dict) ctx)
|
||||
(cond
|
||||
;; if
|
||||
@@ -406,7 +407,7 @@
|
||||
;; async-render-cond-scheme — scheme-style cond for render mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-cond-scheme
|
||||
(define-async async-render-cond-scheme :effects [render io]
|
||||
(fn ((clauses :as list) (env :as dict) ctx)
|
||||
(if (empty? clauses)
|
||||
""
|
||||
@@ -428,7 +429,7 @@
|
||||
;; async-render-cond-clojure — clojure-style cond for render mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-render-cond-clojure
|
||||
(define-async async-render-cond-clojure :effects [render io]
|
||||
(fn ((clauses :as list) (env :as dict) ctx)
|
||||
(if (< (len clauses) 2)
|
||||
""
|
||||
@@ -448,7 +449,7 @@
|
||||
;; async-process-bindings — evaluate let-bindings asynchronously
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-process-bindings
|
||||
(define-async async-process-bindings :effects [render io]
|
||||
(fn (bindings (env :as dict) ctx)
|
||||
;; env-extend (not merge) — Env is not a dict subclass, so merge()
|
||||
;; returns an empty dict, losing all parent scope bindings.
|
||||
@@ -469,7 +470,7 @@
|
||||
local)))
|
||||
|
||||
|
||||
(define-async async-process-bindings-flat
|
||||
(define-async async-process-bindings-flat :effects [render io]
|
||||
(fn ((bindings :as list) (local :as dict) ctx)
|
||||
(let ((skip false)
|
||||
(i 0))
|
||||
@@ -494,7 +495,7 @@
|
||||
;; async-map-fn-render — map a lambda/callable over collection for render
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-map-fn-render
|
||||
(define-async async-map-fn-render :effects [render io]
|
||||
(fn (f (coll :as list) (env :as dict) ctx)
|
||||
(let ((results (list)))
|
||||
(for-each
|
||||
@@ -511,7 +512,7 @@
|
||||
;; async-map-indexed-fn-render — map-indexed variant for render
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-map-indexed-fn-render
|
||||
(define-async async-map-indexed-fn-render :effects [render io]
|
||||
(fn (f (coll :as list) (env :as dict) ctx)
|
||||
(let ((results (list))
|
||||
(i 0))
|
||||
@@ -530,7 +531,7 @@
|
||||
;; async-invoke — call a native callable, await if coroutine
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-invoke
|
||||
(define-async async-invoke :effects [io]
|
||||
(fn (f &rest args)
|
||||
(let ((r (apply f args)))
|
||||
(if (async-coroutine? r)
|
||||
@@ -542,7 +543,7 @@
|
||||
;; Async SX wire format (aser)
|
||||
;; ==========================================================================
|
||||
|
||||
(define-async async-aser
|
||||
(define-async async-aser :effects [render io]
|
||||
(fn (expr (env :as dict) ctx)
|
||||
(case (type-of expr)
|
||||
"number" expr
|
||||
@@ -572,7 +573,7 @@
|
||||
:else expr)))
|
||||
|
||||
|
||||
(define-async async-aser-dict
|
||||
(define-async async-aser-dict :effects [render io]
|
||||
(fn ((expr :as dict) (env :as dict) ctx)
|
||||
(let ((result (dict)))
|
||||
(for-each
|
||||
@@ -586,7 +587,7 @@
|
||||
;; async-aser-list — dispatch on list head for aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-list
|
||||
(define-async async-aser-list :effects [render io]
|
||||
(fn (expr (env :as dict) ctx)
|
||||
(let ((head (first expr))
|
||||
(args (rest expr)))
|
||||
@@ -665,7 +666,7 @@
|
||||
;; async-aser-eval-call — evaluate a function call fully in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-eval-call
|
||||
(define-async async-aser-eval-call :effects [render io]
|
||||
(fn (head (args :as list) (env :as dict) ctx)
|
||||
(let ((f (async-eval head env ctx))
|
||||
(evaled-args (async-eval-args args env ctx)))
|
||||
@@ -693,7 +694,7 @@
|
||||
;; async-eval-args — evaluate a list of args asynchronously
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-eval-args
|
||||
(define-async async-eval-args :effects [io]
|
||||
(fn ((args :as list) (env :as dict) ctx)
|
||||
(let ((results (list)))
|
||||
(for-each
|
||||
@@ -706,7 +707,7 @@
|
||||
;; async-aser-map-list — aser each element of a list
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-map-list
|
||||
(define-async async-aser-map-list :effects [render io]
|
||||
(fn ((exprs :as list) (env :as dict) ctx)
|
||||
(let ((results (list)))
|
||||
(for-each
|
||||
@@ -719,7 +720,7 @@
|
||||
;; async-aser-fragment — serialize (<> child1 child2 ...) in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-fragment
|
||||
(define-async async-aser-fragment :effects [render io]
|
||||
(fn ((children :as list) (env :as dict) ctx)
|
||||
(let ((parts (list)))
|
||||
(for-each
|
||||
@@ -743,7 +744,7 @@
|
||||
;; async-aser-component — expand component server-side in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-component
|
||||
(define-async async-aser-component :effects [render io]
|
||||
(fn ((comp :as component) (args :as list) (env :as dict) ctx)
|
||||
(let ((kwargs (dict))
|
||||
(children (list)))
|
||||
@@ -775,7 +776,7 @@
|
||||
;; async-parse-aser-kw-args — parse keyword args for aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-parse-aser-kw-args
|
||||
(define-async async-parse-aser-kw-args :effects [render io]
|
||||
(fn ((args :as list) (kwargs :as dict) (children :as list) (env :as dict) ctx)
|
||||
(let ((skip false)
|
||||
(i 0))
|
||||
@@ -800,7 +801,7 @@
|
||||
;; async-aser-call — serialize an SX call (tag or component) in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-call
|
||||
(define-async async-aser-call :effects [render io]
|
||||
(fn ((name :as string) (args :as list) (env :as dict) ctx)
|
||||
(let ((token (if (or (= name "svg") (= name "math"))
|
||||
(svg-context-set! true)
|
||||
@@ -853,12 +854,13 @@
|
||||
"let" "let*" "lambda" "fn"
|
||||
"define" "defcomp" "defmacro" "defstyle"
|
||||
"defhandler" "defpage" "defquery" "defaction"
|
||||
"begin" "do" "quote" "->" "set!" "defisland"))
|
||||
"begin" "do" "quote" "->" "set!" "defisland"
|
||||
"deftype" "defeffect"))
|
||||
|
||||
(define ASYNC_ASER_HO_NAMES
|
||||
(list "map" "map-indexed" "filter" "for-each"))
|
||||
|
||||
(define async-aser-form?
|
||||
(define async-aser-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(or (contains? ASYNC_ASER_FORM_NAMES name)
|
||||
(contains? ASYNC_ASER_HO_NAMES name))))
|
||||
@@ -870,7 +872,7 @@
|
||||
;;
|
||||
;; Uses cond-scheme? from eval.sx (the FIXED version with every? check).
|
||||
|
||||
(define-async dispatch-async-aser-form
|
||||
(define-async dispatch-async-aser-form :effects [render io]
|
||||
(fn ((name :as string) expr (env :as dict) ctx)
|
||||
(let ((args (rest expr)))
|
||||
(cond
|
||||
@@ -987,7 +989,8 @@
|
||||
;; Definition forms — evaluate for side effects
|
||||
(or (= name "define") (= name "defcomp") (= name "defmacro")
|
||||
(= name "defstyle") (= name "defhandler") (= name "defpage")
|
||||
(= name "defquery") (= name "defaction"))
|
||||
(= name "defquery") (= name "defaction")
|
||||
(= name "deftype") (= name "defeffect"))
|
||||
(do (async-eval expr env ctx) nil)
|
||||
|
||||
;; Fallback
|
||||
@@ -999,7 +1002,7 @@
|
||||
;; async-aser-cond-scheme — scheme-style cond for aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-cond-scheme
|
||||
(define-async async-aser-cond-scheme :effects [render io]
|
||||
(fn ((clauses :as list) (env :as dict) ctx)
|
||||
(if (empty? clauses)
|
||||
nil
|
||||
@@ -1021,7 +1024,7 @@
|
||||
;; async-aser-cond-clojure — clojure-style cond for aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-cond-clojure
|
||||
(define-async async-aser-cond-clojure :effects [render io]
|
||||
(fn ((clauses :as list) (env :as dict) ctx)
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
@@ -1041,7 +1044,7 @@
|
||||
;; async-aser-case-loop — case dispatch for aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-case-loop
|
||||
(define-async async-aser-case-loop :effects [render io]
|
||||
(fn (match-val (clauses :as list) (env :as dict) ctx)
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
@@ -1061,7 +1064,7 @@
|
||||
;; async-aser-thread-first — -> form in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-thread-first
|
||||
(define-async async-aser-thread-first :effects [render io]
|
||||
(fn ((args :as list) (env :as dict) ctx)
|
||||
(let ((result (async-eval (first args) env ctx)))
|
||||
(for-each
|
||||
@@ -1081,7 +1084,7 @@
|
||||
;; async-invoke-or-lambda — invoke a callable or lambda with args
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-invoke-or-lambda
|
||||
(define-async async-invoke-or-lambda :effects [render io]
|
||||
(fn (f (args :as list) (env :as dict) ctx)
|
||||
(cond
|
||||
(and (callable? f) (not (lambda? f)) (not (component? f)))
|
||||
@@ -1103,7 +1106,7 @@
|
||||
;; Async aser HO forms (map, map-indexed, for-each)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-async async-aser-ho-map
|
||||
(define-async async-aser-ho-map :effects [render io]
|
||||
(fn ((args :as list) (env :as dict) ctx)
|
||||
(let ((f (async-eval (first args) env ctx))
|
||||
(coll (async-eval (nth args 1) env ctx))
|
||||
@@ -1119,7 +1122,7 @@
|
||||
results)))
|
||||
|
||||
|
||||
(define-async async-aser-ho-map-indexed
|
||||
(define-async async-aser-ho-map-indexed :effects [render io]
|
||||
(fn ((args :as list) (env :as dict) ctx)
|
||||
(let ((f (async-eval (first args) env ctx))
|
||||
(coll (async-eval (nth args 1) env ctx))
|
||||
@@ -1138,7 +1141,7 @@
|
||||
results)))
|
||||
|
||||
|
||||
(define-async async-aser-ho-for-each
|
||||
(define-async async-aser-ho-for-each :effects [render io]
|
||||
(fn ((args :as list) (env :as dict) ctx)
|
||||
(let ((f (async-eval (first args) env ctx))
|
||||
(coll (async-eval (nth args 1) env ctx))
|
||||
@@ -1169,7 +1172,7 @@
|
||||
;; (sx-expr? x) — check if SxExpr
|
||||
;; (set-expand-components!) — enable component expansion context var
|
||||
|
||||
(define-async async-eval-slot-inner
|
||||
(define-async async-eval-slot-inner :effects [render io]
|
||||
(fn (expr (env :as dict) ctx)
|
||||
;; NOTE: Uses statement-form let + set! to avoid expression-context
|
||||
;; let (IIFE lambdas) which can't contain await in Python.
|
||||
@@ -1195,7 +1198,7 @@
|
||||
(make-sx-expr (serialize result))))))))
|
||||
|
||||
|
||||
(define-async async-maybe-expand-result
|
||||
(define-async async-maybe-expand-result :effects [render io]
|
||||
(fn (result (env :as dict) ctx)
|
||||
;; If the aser result is a component call string like "(~foo ...)",
|
||||
;; re-parse and expand it. This handles indirect component references
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
;; render-to-dom — main entry point
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-to-dom
|
||||
(define render-to-dom :effects [render]
|
||||
(fn (expr (env :as dict) (ns :as string))
|
||||
(set-render-active! true)
|
||||
(case (type-of expr)
|
||||
@@ -66,7 +66,7 @@
|
||||
;; render-dom-list — dispatch on list head
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-list
|
||||
(define render-dom-list :effects [render]
|
||||
(fn (expr (env :as dict) (ns :as string))
|
||||
(let ((head (first expr)))
|
||||
(cond
|
||||
@@ -165,7 +165,7 @@
|
||||
;; render-dom-element — create a DOM element with attrs and children
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-element
|
||||
(define render-dom-element :effects [render]
|
||||
(fn ((tag :as string) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Detect namespace from tag
|
||||
(let ((new-ns (cond (= tag "svg") SVG_NS
|
||||
@@ -236,7 +236,7 @@
|
||||
;; render-dom-component — expand and render a component
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-component
|
||||
(define render-dom-component :effects [render]
|
||||
(fn ((comp :as component) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Parse kwargs and children, bind into component env, render body.
|
||||
(let ((kwargs (dict))
|
||||
@@ -283,7 +283,7 @@
|
||||
;; render-dom-fragment — render children into a DocumentFragment
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-fragment
|
||||
(define render-dom-fragment :effects [render]
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((frag (create-fragment)))
|
||||
(for-each
|
||||
@@ -296,7 +296,7 @@
|
||||
;; render-dom-raw — insert unescaped content
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-raw
|
||||
(define render-dom-raw :effects [render]
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((frag (create-fragment)))
|
||||
(for-each
|
||||
@@ -317,7 +317,7 @@
|
||||
;; render-dom-unknown-component — visible warning element
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-unknown-component
|
||||
(define render-dom-unknown-component :effects [render]
|
||||
(fn ((name :as string))
|
||||
(error (str "Unknown component: " name))))
|
||||
|
||||
@@ -334,11 +334,11 @@
|
||||
"map" "map-indexed" "filter" "for-each" "portal"
|
||||
"error-boundary"))
|
||||
|
||||
(define render-dom-form?
|
||||
(define render-dom-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(contains? RENDER_DOM_FORMS name)))
|
||||
|
||||
(define dispatch-render-form
|
||||
(define dispatch-render-form :effects [render]
|
||||
(fn ((name :as string) expr (env :as dict) (ns :as string))
|
||||
(cond
|
||||
;; if — reactive inside islands (re-renders when signal deps change)
|
||||
@@ -580,7 +580,7 @@
|
||||
;; render-lambda-dom — render a lambda body in DOM context
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-lambda-dom
|
||||
(define render-lambda-dom :effects [render]
|
||||
(fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Bind lambda params and render body as DOM
|
||||
(let ((local (env-merge (lambda-closure f) env)))
|
||||
@@ -604,7 +604,7 @@
|
||||
;; - Attribute bindings: (deref sig) in attr → reactive attribute
|
||||
;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide
|
||||
|
||||
(define render-dom-island
|
||||
(define render-dom-island :effects [render mutation]
|
||||
(fn ((island :as island) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Parse kwargs and children (same as component)
|
||||
(let ((kwargs (dict))
|
||||
@@ -678,7 +678,7 @@
|
||||
;;
|
||||
;; Supports :tag keyword to change wrapper element (default "div").
|
||||
|
||||
(define render-dom-lake
|
||||
(define render-dom-lake :effects [render]
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((lake-id nil)
|
||||
(lake-tag "div")
|
||||
@@ -722,7 +722,7 @@
|
||||
;; Renders as <div data-sx-marsh="name">children</div>.
|
||||
;; Stores the island env and transform on the element for morph retrieval.
|
||||
|
||||
(define render-dom-marsh
|
||||
(define render-dom-marsh :effects [render]
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((marsh-id nil)
|
||||
(marsh-tag "div")
|
||||
@@ -769,7 +769,7 @@
|
||||
|
||||
;; reactive-text — create a text node bound to a signal
|
||||
;; Used when (deref sig) appears in a text position inside an island.
|
||||
(define reactive-text
|
||||
(define reactive-text :effects [render mutation]
|
||||
(fn (sig)
|
||||
(let ((node (create-text-node (str (deref sig)))))
|
||||
(effect (fn ()
|
||||
@@ -780,7 +780,7 @@
|
||||
;; Used when an attribute value contains (deref sig) inside an island.
|
||||
;; Marks the attribute name on the element via data-sx-reactive-attrs so
|
||||
;; the morph algorithm knows not to overwrite it with server content.
|
||||
(define reactive-attr
|
||||
(define reactive-attr :effects [render mutation]
|
||||
(fn (el (attr-name :as string) (compute-fn :as lambda))
|
||||
;; Mark this attribute as reactively managed
|
||||
(let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
|
||||
@@ -801,7 +801,7 @@
|
||||
|
||||
;; reactive-fragment — conditionally render a fragment based on a signal
|
||||
;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
|
||||
(define reactive-fragment
|
||||
(define reactive-fragment :effects [render mutation]
|
||||
(fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string))
|
||||
(let ((marker (create-comment "island-fragment"))
|
||||
(current-nodes (list)))
|
||||
@@ -823,13 +823,13 @@
|
||||
;; existing DOM nodes are reused across updates. Only additions, removals,
|
||||
;; and reorderings touch the DOM. Without keys, falls back to clear+rerender.
|
||||
|
||||
(define render-list-item
|
||||
(define render-list-item :effects [render]
|
||||
(fn ((map-fn :as lambda) item (env :as dict) (ns :as string))
|
||||
(if (lambda? map-fn)
|
||||
(render-lambda-dom map-fn (list item) env ns)
|
||||
(render-to-dom (apply map-fn (list item)) env ns))))
|
||||
|
||||
(define extract-key
|
||||
(define extract-key :effects [render]
|
||||
(fn (node (index :as number))
|
||||
;; Extract key from rendered node: :key attr, data-key, or index fallback
|
||||
(let ((k (dom-get-attr node "key")))
|
||||
@@ -838,7 +838,7 @@
|
||||
(let ((dk (dom-get-data node "key")))
|
||||
(if dk (str dk) (str "__idx_" index)))))))
|
||||
|
||||
(define reactive-list
|
||||
(define reactive-list :effects [render mutation]
|
||||
(fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string))
|
||||
(let ((container (create-fragment))
|
||||
(marker (create-comment "island-list"))
|
||||
@@ -924,7 +924,7 @@
|
||||
;;
|
||||
;; Handles: input[text/number/email/...], textarea, select, checkbox, radio
|
||||
|
||||
(define bind-input
|
||||
(define bind-input :effects [render mutation]
|
||||
(fn (el (sig :as signal))
|
||||
(let ((input-type (lower (or (dom-get-attr el "type") "")))
|
||||
(is-checkbox (or (= input-type "checkbox")
|
||||
@@ -959,7 +959,7 @@
|
||||
;; position. Registers a disposer to clean up portal content on island
|
||||
;; teardown.
|
||||
|
||||
(define render-dom-portal
|
||||
(define render-dom-portal :effects [render]
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((selector (trampoline (eval-expr (first args) env)))
|
||||
(target (or (dom-query selector)
|
||||
@@ -999,7 +999,7 @@
|
||||
;; (fn (err retry) ...)
|
||||
;; Calling (retry) re-renders the body, replacing the fallback.
|
||||
|
||||
(define render-dom-error-boundary
|
||||
(define render-dom-error-boundary :effects [render]
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((fallback-expr (first args))
|
||||
(body-exprs (rest args))
|
||||
|
||||
@@ -13,7 +13,7 @@
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
(define render-to-html
|
||||
(define render-to-html :effects [render]
|
||||
(fn (expr (env :as dict))
|
||||
(set-render-active! true)
|
||||
(case (type-of expr)
|
||||
@@ -33,7 +33,7 @@
|
||||
;; Everything else — evaluate first
|
||||
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
|
||||
(define render-value-to-html
|
||||
(define render-value-to-html :effects [render]
|
||||
(fn (val (env :as dict))
|
||||
(case (type-of val)
|
||||
"nil" ""
|
||||
@@ -52,9 +52,10 @@
|
||||
(define RENDER_HTML_FORMS
|
||||
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
|
||||
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
|
||||
"deftype" "defeffect"
|
||||
"map" "map-indexed" "filter" "for-each"))
|
||||
|
||||
(define render-html-form?
|
||||
(define render-html-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(contains? RENDER_HTML_FORMS name)))
|
||||
|
||||
@@ -63,7 +64,7 @@
|
||||
;; render-list-to-html — dispatch on list head
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-list-to-html
|
||||
(define render-list-to-html :effects [render]
|
||||
(fn ((expr :as list) (env :as dict))
|
||||
(if (empty? expr)
|
||||
""
|
||||
@@ -134,7 +135,7 @@
|
||||
;; dispatch-html-form — render-aware special form handling for HTML output
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispatch-html-form
|
||||
(define dispatch-html-form :effects [render]
|
||||
(fn ((name :as string) (expr :as list) (env :as dict))
|
||||
(cond
|
||||
;; if
|
||||
@@ -234,7 +235,7 @@
|
||||
;; render-lambda-html — render a lambda body in HTML context
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-lambda-html
|
||||
(define render-lambda-html :effects [render]
|
||||
(fn ((f :as lambda) (args :as list) (env :as dict))
|
||||
(let ((local (env-merge (lambda-closure f) env)))
|
||||
(for-each-indexed
|
||||
@@ -248,7 +249,7 @@
|
||||
;; render-html-component — expand and render a component
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-html-component
|
||||
(define render-html-component :effects [render]
|
||||
(fn ((comp :as component) (args :as list) (env :as dict))
|
||||
;; Expand component and render body through HTML adapter.
|
||||
;; Component body contains rendering forms (HTML tags) that only the
|
||||
@@ -287,7 +288,7 @@
|
||||
(render-to-html (component-body comp) local)))))
|
||||
|
||||
|
||||
(define render-html-element
|
||||
(define render-html-element :effects [render]
|
||||
(fn ((tag :as string) (args :as list) (env :as dict))
|
||||
(let ((parsed (parse-element-args args env))
|
||||
(attrs (first parsed))
|
||||
@@ -311,7 +312,7 @@
|
||||
;; Lakes are server territory inside islands. The morph can update lake
|
||||
;; content while preserving surrounding reactive DOM.
|
||||
|
||||
(define render-html-lake
|
||||
(define render-html-lake :effects [render]
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((lake-id nil)
|
||||
(lake-tag "div")
|
||||
@@ -350,7 +351,7 @@
|
||||
;; re-evaluated in the island's signal scope. Server renders children normally;
|
||||
;; the :transform is a client-only concern.
|
||||
|
||||
(define render-html-marsh
|
||||
(define render-html-marsh :effects [render]
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((marsh-id nil)
|
||||
(marsh-tag "div")
|
||||
@@ -393,7 +394,7 @@
|
||||
;; (reset! s v) → no-op
|
||||
;; (swap! s f) → no-op
|
||||
|
||||
(define render-html-island
|
||||
(define render-html-island :effects [render]
|
||||
(fn ((island :as island) (args :as list) (env :as dict))
|
||||
;; Parse kwargs and children (same pattern as render-html-component)
|
||||
(let ((kwargs (dict))
|
||||
@@ -451,7 +452,7 @@
|
||||
;; Uses the SX serializer (not JSON) so the client can parse with sx-parse.
|
||||
;; Handles all SX types natively: numbers, strings, booleans, nil, lists, dicts.
|
||||
|
||||
(define serialize-island-state
|
||||
(define serialize-island-state :effects []
|
||||
(fn ((kwargs :as dict))
|
||||
(if (empty-dict? kwargs)
|
||||
nil
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
(define render-to-sx
|
||||
(define render-to-sx :effects [render]
|
||||
(fn (expr (env :as dict))
|
||||
(let ((result (aser expr env)))
|
||||
;; aser-call already returns serialized SX strings;
|
||||
@@ -20,8 +20,8 @@
|
||||
result
|
||||
(serialize result)))))
|
||||
|
||||
(define aser
|
||||
(fn (expr (env :as dict))
|
||||
(define aser :effects [render]
|
||||
(fn ((expr :as any) (env :as dict))
|
||||
;; Evaluate for SX wire format — serialize rendering forms,
|
||||
;; evaluate control flow and function calls.
|
||||
(set-render-active! true)
|
||||
@@ -51,7 +51,7 @@
|
||||
:else expr)))
|
||||
|
||||
|
||||
(define aser-list
|
||||
(define aser-list :effects [render]
|
||||
(fn ((expr :as list) (env :as dict))
|
||||
(let ((head (first expr))
|
||||
(args (rest expr)))
|
||||
@@ -103,7 +103,7 @@
|
||||
:else (error (str "Not callable: " (inspect f)))))))))))
|
||||
|
||||
|
||||
(define aser-fragment
|
||||
(define aser-fragment :effects [render]
|
||||
(fn ((children :as list) (env :as dict))
|
||||
;; Serialize (<> child1 child2 ...) to sx source string
|
||||
;; Must flatten list results (e.g. from map/filter) to avoid nested parens
|
||||
@@ -125,7 +125,7 @@
|
||||
(str "(<> " (join " " parts) ")")))))
|
||||
|
||||
|
||||
(define aser-call
|
||||
(define aser-call :effects [render]
|
||||
(fn ((name :as string) (args :as list) (env :as dict))
|
||||
;; Serialize (name :key val child ...) — evaluate args but keep as sx
|
||||
;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops
|
||||
@@ -170,17 +170,18 @@
|
||||
"define" "defcomp" "defmacro" "defstyle"
|
||||
"defhandler" "defpage" "defquery" "defaction" "defrelation"
|
||||
"begin" "do" "quote" "quasiquote"
|
||||
"->" "set!" "letrec" "dynamic-wind" "defisland"))
|
||||
"->" "set!" "letrec" "dynamic-wind" "defisland"
|
||||
"deftype" "defeffect"))
|
||||
|
||||
(define HO_FORM_NAMES
|
||||
(list "map" "map-indexed" "filter" "reduce"
|
||||
"some" "every?" "for-each"))
|
||||
|
||||
(define special-form?
|
||||
(define special-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(contains? SPECIAL_FORM_NAMES name)))
|
||||
|
||||
(define ho-form?
|
||||
(define ho-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(contains? HO_FORM_NAMES name)))
|
||||
|
||||
@@ -193,7 +194,7 @@
|
||||
;; through aser (serializing tags/components instead of rendering HTML).
|
||||
;; Definition forms evaluate for side effects and return nil.
|
||||
|
||||
(define aser-special
|
||||
(define aser-special :effects [render]
|
||||
(fn ((name :as string) (expr :as list) (env :as dict))
|
||||
(let ((args (rest expr)))
|
||||
(cond
|
||||
@@ -304,7 +305,8 @@
|
||||
;; 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"))
|
||||
(= name "defquery") (= name "defaction") (= name "defrelation")
|
||||
(= name "deftype") (= name "defeffect"))
|
||||
(do (trampoline (eval-expr expr env)) nil)
|
||||
|
||||
;; Everything else — evaluate normally
|
||||
@@ -313,7 +315,7 @@
|
||||
|
||||
|
||||
;; Helper: case dispatch for aser mode
|
||||
(define eval-case-aser
|
||||
(define eval-case-aser :effects [render]
|
||||
(fn (match-val (clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
|
||||
@@ -26,7 +26,7 @@
|
||||
(define HEAD_HOIST_SELECTOR
|
||||
"meta, title, link[rel='canonical'], script[type='application/ld+json']")
|
||||
|
||||
(define hoist-head-elements-full
|
||||
(define hoist-head-elements-full :effects [mutation io]
|
||||
(fn (root)
|
||||
(let ((els (dom-query-all root HEAD_HOIST_SELECTOR)))
|
||||
(for-each
|
||||
@@ -71,7 +71,7 @@
|
||||
;; Mount — render SX source into a DOM element
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-mount
|
||||
(define sx-mount :effects [mutation io]
|
||||
(fn (target (source :as string) (extra-env :as dict))
|
||||
;; Render SX source string into target element.
|
||||
;; target: Element or CSS selector string
|
||||
@@ -100,7 +100,7 @@
|
||||
;; Finds the suspense wrapper by data-suspense attribute, renders the
|
||||
;; new SX content, and replaces the wrapper's children.
|
||||
|
||||
(define resolve-suspense
|
||||
(define resolve-suspense :effects [mutation io]
|
||||
(fn ((id :as string) (sx :as string))
|
||||
;; Process any new <script type="text/sx"> tags that arrived via
|
||||
;; streaming (e.g. extra component defs) before resolving.
|
||||
@@ -127,7 +127,7 @@
|
||||
;; Hydrate — render all [data-sx] elements
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-hydrate-elements
|
||||
(define sx-hydrate-elements :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Find all [data-sx] elements within root and render them.
|
||||
(let ((els (dom-query-all (or root (dom-body)) "[data-sx]")))
|
||||
@@ -143,7 +143,7 @@
|
||||
;; Update — re-render a [data-sx] element with new env data
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-update-element
|
||||
(define sx-update-element :effects [mutation io]
|
||||
(fn (el new-env)
|
||||
;; Re-render a [data-sx] element.
|
||||
;; Reads source from data-sx attr, base env from data-sx-env attr.
|
||||
@@ -165,7 +165,7 @@
|
||||
;; Render component — build synthetic call from kwargs dict
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-render-component
|
||||
(define sx-render-component :effects [mutation io]
|
||||
(fn ((name :as string) (kwargs :as dict) (extra-env :as dict))
|
||||
;; Render a named component with keyword args.
|
||||
;; name: component name (with or without ~ prefix)
|
||||
@@ -190,7 +190,7 @@
|
||||
;; Script processing — <script type="text/sx">
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-sx-scripts
|
||||
(define process-sx-scripts :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Process all <script type="text/sx"> tags.
|
||||
;; - data-components + data-hash → localStorage cache
|
||||
@@ -235,7 +235,7 @@
|
||||
;; Component script with caching
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-component-script
|
||||
(define process-component-script :effects [mutation io]
|
||||
(fn (script (text :as string))
|
||||
;; Handle <script type="text/sx" data-components data-hash="...">
|
||||
(let ((hash (dom-get-attr script "data-hash")))
|
||||
@@ -288,7 +288,7 @@
|
||||
|
||||
(define _page-routes (list))
|
||||
|
||||
(define process-page-scripts
|
||||
(define process-page-scripts :effects [mutation io]
|
||||
(fn ()
|
||||
;; Process <script type="text/sx-pages"> tags.
|
||||
;; Parses SX page registry and builds route entries with parsed patterns.
|
||||
@@ -331,7 +331,7 @@
|
||||
;; 5. Morph existing DOM to preserve structure, focus, scroll
|
||||
;; 6. Store disposers on the element for cleanup
|
||||
|
||||
(define sx-hydrate-islands
|
||||
(define sx-hydrate-islands :effects [mutation io]
|
||||
(fn (root)
|
||||
(let ((els (dom-query-all (or root (dom-body)) "[data-sx-island]")))
|
||||
(for-each
|
||||
@@ -341,7 +341,7 @@
|
||||
(hydrate-island el)))
|
||||
els))))
|
||||
|
||||
(define hydrate-island
|
||||
(define hydrate-island :effects [mutation io]
|
||||
(fn (el)
|
||||
(let ((name (dom-get-attr el "data-sx-island"))
|
||||
(state-sx (or (dom-get-attr el "data-sx-state") "{}")))
|
||||
@@ -388,7 +388,7 @@
|
||||
;; Island disposal — clean up when island removed from DOM
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispose-island
|
||||
(define dispose-island :effects [mutation io]
|
||||
(fn (el)
|
||||
(let ((disposers (dom-get-data el "sx-disposers")))
|
||||
(when disposers
|
||||
@@ -398,7 +398,7 @@
|
||||
disposers)
|
||||
(dom-set-data el "sx-disposers" nil)))))
|
||||
|
||||
(define dispose-islands-in
|
||||
(define dispose-islands-in :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Dispose islands within root, but SKIP hydrated islands —
|
||||
;; they may be preserved across morphs. Only dispose islands
|
||||
@@ -419,7 +419,7 @@
|
||||
;; Full boot sequence
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define boot-init
|
||||
(define boot-init :effects [mutation io]
|
||||
(fn ()
|
||||
;; Full browser initialization:
|
||||
;; 1. CSS tracking
|
||||
|
||||
@@ -664,6 +664,11 @@ class PyEmitter:
|
||||
def _emit_define(self, expr, indent: int = 0) -> str:
|
||||
pad = " " * indent
|
||||
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
|
||||
# Handle (define name :effects [...] value) — skip :effects annotation
|
||||
if (len(expr) >= 5 and isinstance(expr[2], Keyword)
|
||||
and expr[2].name == "effects"):
|
||||
val_expr = expr[4]
|
||||
else:
|
||||
val_expr = expr[2]
|
||||
# Always emit fn-bodied defines as def statements for flat control flow
|
||||
if (isinstance(val_expr, list) and val_expr and
|
||||
@@ -675,6 +680,11 @@ class PyEmitter:
|
||||
def _emit_define_async(self, expr, indent: int = 0) -> str:
|
||||
"""Emit a define-async form as an async def statement."""
|
||||
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
|
||||
# Handle (define-async name :effects [...] value) — skip :effects annotation
|
||||
if (len(expr) >= 5 and isinstance(expr[2], Keyword)
|
||||
and expr[2].name == "effects"):
|
||||
val_expr = expr[4]
|
||||
else:
|
||||
val_expr = expr[2]
|
||||
if (isinstance(val_expr, list) and val_expr and
|
||||
isinstance(val_expr[0], Symbol) and val_expr[0].name in ("fn", "lambda")):
|
||||
|
||||
@@ -12,6 +12,7 @@
|
||||
;; (define-io-primitive "name"
|
||||
;; :params (param1 param2 &key ...)
|
||||
;; :returns "type"
|
||||
;; :effects [io]
|
||||
;; :async true
|
||||
;; :doc "description"
|
||||
;; :context :request)
|
||||
@@ -38,6 +39,7 @@
|
||||
(define-io-primitive "current-user"
|
||||
:params ()
|
||||
:returns "dict?"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Current authenticated user dict, or nil."
|
||||
:context :request)
|
||||
@@ -45,6 +47,7 @@
|
||||
(define-io-primitive "request-arg"
|
||||
:params (name &rest default)
|
||||
:returns "any"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Read a query string argument from the current request."
|
||||
:context :request)
|
||||
@@ -52,6 +55,7 @@
|
||||
(define-io-primitive "request-path"
|
||||
:params ()
|
||||
:returns "string"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Current request path."
|
||||
:context :request)
|
||||
@@ -59,6 +63,7 @@
|
||||
(define-io-primitive "request-view-args"
|
||||
:params (key)
|
||||
:returns "any"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Read a URL view argument from the current request."
|
||||
:context :request)
|
||||
@@ -66,6 +71,7 @@
|
||||
(define-io-primitive "csrf-token"
|
||||
:params ()
|
||||
:returns "string"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Current CSRF token string."
|
||||
:context :request)
|
||||
@@ -73,6 +79,7 @@
|
||||
(define-io-primitive "abort"
|
||||
:params (status &rest message)
|
||||
:returns "nil"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Raise HTTP error from SX."
|
||||
:context :request)
|
||||
@@ -82,6 +89,7 @@
|
||||
(define-io-primitive "url-for"
|
||||
:params (endpoint &key)
|
||||
:returns "string"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Generate URL for a named endpoint."
|
||||
:context :request)
|
||||
@@ -89,6 +97,7 @@
|
||||
(define-io-primitive "route-prefix"
|
||||
:params ()
|
||||
:returns "string"
|
||||
:effects [io]
|
||||
:async true
|
||||
:doc "Service URL prefix for dev/prod routing."
|
||||
:context :request)
|
||||
@@ -98,6 +107,7 @@
|
||||
(define-io-primitive "app-url"
|
||||
:params (service &rest path)
|
||||
:returns "string"
|
||||
:effects [io]
|
||||
:async false
|
||||
:doc "Full URL for a service: (app-url \"blog\" \"/my-post/\")."
|
||||
:context :config)
|
||||
@@ -105,6 +115,7 @@
|
||||
(define-io-primitive "asset-url"
|
||||
:params (&rest path)
|
||||
:returns "string"
|
||||
:effects [io]
|
||||
:async false
|
||||
:doc "Versioned static asset URL."
|
||||
:context :config)
|
||||
@@ -112,6 +123,7 @@
|
||||
(define-io-primitive "config"
|
||||
:params (key)
|
||||
:returns "any"
|
||||
:effects [io]
|
||||
:async false
|
||||
:doc "Read a value from host configuration."
|
||||
:context :config)
|
||||
@@ -126,6 +138,124 @@
|
||||
"list" "dict" "sx-source"))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Web interop — reading non-SX request formats
|
||||
;;
|
||||
;; SX's native wire format is SX (text/sx). These primitives bridge to
|
||||
;; legacy web formats: HTML form encoding, JSON bodies, HTTP headers.
|
||||
;; They're useful for interop but not fundamental to SX-to-SX communication.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define-io-primitive "now"
|
||||
:params (&rest format)
|
||||
:returns "string"
|
||||
:async true
|
||||
:doc "Current timestamp. Optional format string (strftime). Default ISO 8601."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "sleep"
|
||||
:params (ms)
|
||||
:returns "nil"
|
||||
:async true
|
||||
:doc "Pause execution for ms milliseconds. For demos and testing."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-form"
|
||||
:params (name &rest default)
|
||||
:returns "any"
|
||||
:async true
|
||||
:doc "Read a form field from a POST/PUT/PATCH request body."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-json"
|
||||
:params ()
|
||||
:returns "dict?"
|
||||
:async true
|
||||
:doc "Read JSON body from the current request, or nil if not JSON."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-header"
|
||||
:params (name &rest default)
|
||||
:returns "string?"
|
||||
:async true
|
||||
:doc "Read a request header value by name."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-content-type"
|
||||
:params ()
|
||||
:returns "string?"
|
||||
:async true
|
||||
:doc "Content-Type of the current request."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-args-all"
|
||||
:params ()
|
||||
:returns "dict"
|
||||
:async true
|
||||
:doc "All query string parameters as a dict."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-form-all"
|
||||
:params ()
|
||||
:returns "dict"
|
||||
:async true
|
||||
:doc "All form fields as a dict."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-form-list"
|
||||
:params (field-name)
|
||||
:returns "list"
|
||||
:async true
|
||||
:doc "All values for a multi-value form field as a list."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-headers-all"
|
||||
:params ()
|
||||
:returns "dict"
|
||||
:async true
|
||||
:doc "All request headers as a dict (lowercase keys)."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "request-file-name"
|
||||
:params (field-name)
|
||||
:returns "string?"
|
||||
:async true
|
||||
:doc "Filename of an uploaded file by field name, or nil."
|
||||
:context :request)
|
||||
|
||||
;; Response manipulation
|
||||
|
||||
(define-io-primitive "set-response-header"
|
||||
:params (name value)
|
||||
:returns "nil"
|
||||
:async true
|
||||
:doc "Set a response header. Applied after handler returns."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "set-response-status"
|
||||
:params (status)
|
||||
:returns "nil"
|
||||
:async true
|
||||
:doc "Set the HTTP response status code. Applied after handler returns."
|
||||
:context :request)
|
||||
|
||||
;; Ephemeral state — per-process, resets on restart
|
||||
|
||||
(define-io-primitive "state-get"
|
||||
:params (key &rest default)
|
||||
:returns "any"
|
||||
:async true
|
||||
:doc "Read from ephemeral per-process state dict."
|
||||
:context :request)
|
||||
|
||||
(define-io-primitive "state-set!"
|
||||
:params (key value)
|
||||
:returns "nil"
|
||||
:async true
|
||||
:doc "Write to ephemeral per-process state dict."
|
||||
:context :request)
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Tier 3: Signal primitives — reactive state for islands
|
||||
;;
|
||||
@@ -138,11 +268,13 @@
|
||||
(declare-signal-primitive "signal"
|
||||
:params (initial-value)
|
||||
:returns "signal"
|
||||
:effects []
|
||||
:doc "Create a reactive signal container with an initial value.")
|
||||
|
||||
(declare-signal-primitive "deref"
|
||||
:params (signal)
|
||||
:returns "any"
|
||||
:effects []
|
||||
:doc "Read a signal's current value. In a reactive context (inside an island),
|
||||
subscribes the current DOM binding to the signal. Outside reactive
|
||||
context, just returns the value.")
|
||||
@@ -150,23 +282,27 @@
|
||||
(declare-signal-primitive "reset!"
|
||||
:params (signal value)
|
||||
:returns "nil"
|
||||
:effects [mutation]
|
||||
:doc "Set a signal to a new value. Notifies all subscribers.")
|
||||
|
||||
(declare-signal-primitive "swap!"
|
||||
:params (signal f &rest args)
|
||||
:returns "nil"
|
||||
:effects [mutation]
|
||||
:doc "Update a signal by applying f to its current value. (swap! s inc)
|
||||
is equivalent to (reset! s (inc (deref s))) but atomic.")
|
||||
|
||||
(declare-signal-primitive "computed"
|
||||
:params (compute-fn)
|
||||
:returns "signal"
|
||||
:effects []
|
||||
:doc "Create a derived signal that recomputes when its dependencies change.
|
||||
Dependencies are discovered automatically by tracking deref calls.")
|
||||
|
||||
(declare-signal-primitive "effect"
|
||||
:params (effect-fn)
|
||||
:returns "lambda"
|
||||
:effects [mutation]
|
||||
:doc "Run a side effect that re-runs when its signal dependencies change.
|
||||
Returns a dispose function. If the effect function returns a function,
|
||||
it is called as cleanup before the next run.")
|
||||
@@ -174,5 +310,6 @@
|
||||
(declare-signal-primitive "batch"
|
||||
:params (thunk)
|
||||
:returns "any"
|
||||
:effects [mutation]
|
||||
:doc "Group multiple signal writes. Subscribers are notified once at the end,
|
||||
after all values have been updated.")
|
||||
|
||||
@@ -31,14 +31,14 @@
|
||||
;; Walks all branches of control flow (if/when/cond/case) to find
|
||||
;; every component that *could* be rendered.
|
||||
|
||||
(define scan-refs
|
||||
(define scan-refs :effects []
|
||||
(fn (node)
|
||||
(let ((refs (list)))
|
||||
(scan-refs-walk node refs)
|
||||
refs)))
|
||||
|
||||
|
||||
(define scan-refs-walk
|
||||
(define scan-refs-walk :effects []
|
||||
(fn (node (refs :as list))
|
||||
(cond
|
||||
;; Symbol starting with ~ → component reference
|
||||
@@ -67,7 +67,7 @@
|
||||
;; Given a component name and an environment, compute all components
|
||||
;; that it can transitively render. Handles cycles via seen-set.
|
||||
|
||||
(define transitive-deps-walk
|
||||
(define transitive-deps-walk :effects []
|
||||
(fn ((n :as string) (seen :as list) (env :as dict))
|
||||
(when (not (contains? seen n))
|
||||
(append! seen n)
|
||||
@@ -82,7 +82,7 @@
|
||||
:else nil)))))
|
||||
|
||||
|
||||
(define transitive-deps
|
||||
(define transitive-deps :effects []
|
||||
(fn ((name :as string) (env :as dict))
|
||||
(let ((seen (list))
|
||||
(key (if (starts-with? name "~") name (str "~" name))))
|
||||
@@ -100,7 +100,7 @@
|
||||
;; (env-components env) → list of component names in env
|
||||
;; (component-set-deps! comp deps) → store deps on component
|
||||
|
||||
(define compute-all-deps
|
||||
(define compute-all-deps :effects [mutation]
|
||||
(fn ((env :as dict))
|
||||
(for-each
|
||||
(fn ((name :as string))
|
||||
@@ -119,7 +119,7 @@
|
||||
;; Platform interface:
|
||||
;; (regex-find-all pattern source) → list of matched group strings
|
||||
|
||||
(define scan-components-from-source
|
||||
(define scan-components-from-source :effects []
|
||||
(fn ((source :as string))
|
||||
(let ((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-]*)" source)))
|
||||
(map (fn ((m :as string)) (str "~" m)) matches))))
|
||||
@@ -131,7 +131,7 @@
|
||||
;; Scans page source for direct component references, then computes
|
||||
;; the transitive closure. Returns list of ~names.
|
||||
|
||||
(define components-needed
|
||||
(define components-needed :effects []
|
||||
(fn ((page-source :as string) (env :as dict))
|
||||
(let ((direct (scan-components-from-source page-source))
|
||||
(all-needed (list)))
|
||||
@@ -165,7 +165,7 @@
|
||||
;;
|
||||
;; This replaces the "send everything" approach with per-page bundles.
|
||||
|
||||
(define page-component-bundle
|
||||
(define page-component-bundle :effects []
|
||||
(fn ((page-source :as string) (env :as dict))
|
||||
(components-needed page-source env)))
|
||||
|
||||
@@ -180,7 +180,7 @@
|
||||
;; (component-css-classes c) → set/list of class strings
|
||||
;; (scan-css-classes source) → set/list of class strings from source
|
||||
|
||||
(define page-css-classes
|
||||
(define page-css-classes :effects []
|
||||
(fn ((page-source :as string) (env :as dict))
|
||||
(let ((needed (components-needed page-source env))
|
||||
(classes (list)))
|
||||
@@ -218,7 +218,7 @@
|
||||
;; (component-io-refs c) → cached IO ref list (may be empty)
|
||||
;; (component-set-io-refs! c r) → cache IO refs on component
|
||||
|
||||
(define scan-io-refs-walk
|
||||
(define scan-io-refs-walk :effects []
|
||||
(fn (node (io-names :as list) (refs :as list))
|
||||
(cond
|
||||
;; Symbol → check if name is in the IO set
|
||||
@@ -241,7 +241,7 @@
|
||||
:else nil)))
|
||||
|
||||
|
||||
(define scan-io-refs
|
||||
(define scan-io-refs :effects []
|
||||
(fn (node (io-names :as list))
|
||||
(let ((refs (list)))
|
||||
(scan-io-refs-walk node io-names refs)
|
||||
@@ -252,7 +252,7 @@
|
||||
;; 9. Transitive IO refs — follow component deps and union IO refs
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define transitive-io-refs-walk
|
||||
(define transitive-io-refs-walk :effects []
|
||||
(fn ((n :as string) (seen :as list) (all-refs :as list) (env :as dict) (io-names :as list))
|
||||
(when (not (contains? seen n))
|
||||
(append! seen n)
|
||||
@@ -285,7 +285,7 @@
|
||||
:else nil)))))
|
||||
|
||||
|
||||
(define transitive-io-refs
|
||||
(define transitive-io-refs :effects []
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((all-refs (list))
|
||||
(seen (list))
|
||||
@@ -298,7 +298,7 @@
|
||||
;; 10. Compute IO refs for all components in an environment
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compute-all-io-refs
|
||||
(define compute-all-io-refs :effects [mutation]
|
||||
(fn ((env :as dict) (io-names :as list))
|
||||
(for-each
|
||||
(fn ((name :as string))
|
||||
@@ -308,7 +308,7 @@
|
||||
(env-components env))))
|
||||
|
||||
|
||||
(define component-io-refs-cached
|
||||
(define component-io-refs-cached :effects []
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((key (if (starts-with? name "~") name (str "~" name))))
|
||||
(let ((val (env-get env key)))
|
||||
@@ -319,7 +319,7 @@
|
||||
;; Fallback: not yet cached (shouldn't happen after compute-all-io-refs)
|
||||
(transitive-io-refs name env io-names))))))
|
||||
|
||||
(define component-pure?
|
||||
(define component-pure? :effects []
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((key (if (starts-with? name "~") name (str "~" name))))
|
||||
(let ((val (env-get env key)))
|
||||
@@ -343,7 +343,7 @@
|
||||
;;
|
||||
;; Returns: "server" | "client"
|
||||
|
||||
(define render-target
|
||||
(define render-target :effects []
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((key (if (starts-with? name "~") name (str "~" name))))
|
||||
(let ((val (env-get env key)))
|
||||
@@ -372,7 +372,7 @@
|
||||
;; The async evaluator and client router both use it to make decisions
|
||||
;; without recomputing at every request.
|
||||
|
||||
(define page-render-plan
|
||||
(define page-render-plan :effects []
|
||||
(fn ((page-source :as string) (env :as dict) (io-names :as list))
|
||||
(let ((needed (components-needed page-source env))
|
||||
(comp-targets (dict))
|
||||
@@ -450,7 +450,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Moved from platform to spec: pure logic using type predicates.
|
||||
|
||||
(define env-components
|
||||
(define env-components :effects []
|
||||
(fn ((env :as dict))
|
||||
(filter
|
||||
(fn ((k :as string))
|
||||
|
||||
@@ -31,7 +31,7 @@
|
||||
;; Parses the sx-trigger attribute value into a list of trigger descriptors.
|
||||
;; Each descriptor is a dict with "event" and "modifiers" keys.
|
||||
|
||||
(define parse-time
|
||||
(define parse-time :effects []
|
||||
(fn ((s :as string))
|
||||
;; Parse time string: "2s" → 2000, "500ms" → 500
|
||||
;; Uses nested if (not cond) because cond misclassifies 2-element
|
||||
@@ -42,7 +42,7 @@
|
||||
(parse-int s 0))))))
|
||||
|
||||
|
||||
(define parse-trigger-spec
|
||||
(define parse-trigger-spec :effects []
|
||||
(fn ((spec :as string))
|
||||
;; Parse "click delay:500ms once,change" → list of trigger descriptors
|
||||
(if (nil? spec)
|
||||
@@ -80,7 +80,7 @@
|
||||
raw-parts))))))
|
||||
|
||||
|
||||
(define default-trigger
|
||||
(define default-trigger :effects []
|
||||
(fn ((tag-name :as string))
|
||||
;; Default trigger for element type
|
||||
(cond
|
||||
@@ -98,7 +98,7 @@
|
||||
;; Verb extraction
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define get-verb-info
|
||||
(define get-verb-info :effects [io]
|
||||
(fn (el)
|
||||
;; Check element for sx-get, sx-post, etc. Returns (dict "method" "url") or nil.
|
||||
(some
|
||||
@@ -114,7 +114,7 @@
|
||||
;; Request header building
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-request-headers
|
||||
(define build-request-headers :effects [io]
|
||||
(fn (el (loaded-components :as list) (css-hash :as string))
|
||||
;; Build the SX request headers dict
|
||||
(let ((headers (dict
|
||||
@@ -150,7 +150,7 @@
|
||||
;; Response header processing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-response-headers
|
||||
(define process-response-headers :effects []
|
||||
(fn ((get-header :as lambda))
|
||||
;; Extract all SX response header directives into a dict.
|
||||
;; get-header is (fn (name) → string or nil).
|
||||
@@ -174,7 +174,7 @@
|
||||
;; Swap specification parsing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-swap-spec
|
||||
(define parse-swap-spec :effects []
|
||||
(fn ((raw-swap :as string) (global-transitions? :as boolean))
|
||||
;; Parse "innerHTML transition:true" → dict with style + transition flag
|
||||
(let ((parts (split (or raw-swap DEFAULT_SWAP) " "))
|
||||
@@ -193,7 +193,7 @@
|
||||
;; Retry logic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-retry-spec
|
||||
(define parse-retry-spec :effects []
|
||||
(fn ((retry-attr :as string))
|
||||
;; Parse "exponential:1000:30000" → spec dict or nil
|
||||
(if (nil? retry-attr)
|
||||
@@ -205,7 +205,7 @@
|
||||
"cap-ms" (parse-int (nth parts 2) 30000))))))
|
||||
|
||||
|
||||
(define next-retry-ms
|
||||
(define next-retry-ms :effects []
|
||||
(fn ((current-ms :as number) (cap-ms :as number))
|
||||
;; Exponential backoff: double current, cap at max
|
||||
(min (* current-ms 2) cap-ms)))
|
||||
@@ -215,7 +215,7 @@
|
||||
;; Form parameter filtering
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define filter-params
|
||||
(define filter-params :effects []
|
||||
(fn ((params-spec :as string) (all-params :as list))
|
||||
;; Filter form parameters by sx-params spec.
|
||||
;; all-params is a list of (key value) pairs.
|
||||
@@ -239,7 +239,7 @@
|
||||
;; Target resolution
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define resolve-target
|
||||
(define resolve-target :effects [io]
|
||||
(fn (el)
|
||||
;; Resolve the swap target for an element
|
||||
(let ((sel (dom-get-attr el "sx-target")))
|
||||
@@ -253,7 +253,7 @@
|
||||
;; Optimistic updates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define apply-optimistic
|
||||
(define apply-optimistic :effects [mutation io]
|
||||
(fn (el)
|
||||
;; Apply optimistic update preview. Returns state for reverting, or nil.
|
||||
(let ((directive (dom-get-attr el "sx-optimistic")))
|
||||
@@ -278,7 +278,7 @@
|
||||
state)))))
|
||||
|
||||
|
||||
(define revert-optimistic
|
||||
(define revert-optimistic :effects [mutation io]
|
||||
(fn ((state :as dict))
|
||||
;; Revert an optimistic update
|
||||
(when state
|
||||
@@ -299,7 +299,7 @@
|
||||
;; Out-of-band swap identification
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define find-oob-swaps
|
||||
(define find-oob-swaps :effects [mutation io]
|
||||
(fn (container)
|
||||
;; Find elements marked for out-of-band swapping.
|
||||
;; Returns list of (dict "element" el "swap-type" type "target-id" id).
|
||||
@@ -329,7 +329,7 @@
|
||||
;; preserving event listeners, focus, scroll position, and form state
|
||||
;; on keyed (id) elements.
|
||||
|
||||
(define morph-node
|
||||
(define morph-node :effects [mutation io]
|
||||
(fn (old-node new-node)
|
||||
;; Morph old-node to match new-node, preserving listeners/state.
|
||||
(cond
|
||||
@@ -371,7 +371,7 @@
|
||||
(morph-children old-node new-node))))))
|
||||
|
||||
|
||||
(define sync-attrs
|
||||
(define sync-attrs :effects [mutation io]
|
||||
(fn (old-el new-el)
|
||||
;; Sync attributes from new to old, but skip reactively managed attrs.
|
||||
;; data-sx-reactive-attrs="style,class" means those attrs are owned by
|
||||
@@ -398,7 +398,7 @@
|
||||
(dom-attr-list old-el)))))
|
||||
|
||||
|
||||
(define morph-children
|
||||
(define morph-children :effects [mutation io]
|
||||
(fn (old-parent new-parent)
|
||||
;; Reconcile children of old-parent to match new-parent.
|
||||
;; Keyed elements (with id) are matched and moved in-place.
|
||||
@@ -472,7 +472,7 @@
|
||||
;; - Lakes = server substance (content, morphed)
|
||||
;; - The morph = Aufhebung (cancellation/preservation/elevation of both)
|
||||
|
||||
(define morph-island-children
|
||||
(define morph-island-children :effects [mutation io]
|
||||
(fn (old-island new-island)
|
||||
;; Find all lake and marsh slots in both old and new islands
|
||||
(let ((old-lakes (dom-query-all old-island "[data-sx-lake]"))
|
||||
@@ -522,7 +522,7 @@
|
||||
;; as SX and rendered in the island's signal context. If the marsh has a
|
||||
;; :transform function, it reshapes the content before evaluation.
|
||||
|
||||
(define morph-marsh
|
||||
(define morph-marsh :effects [mutation io]
|
||||
(fn (old-marsh new-marsh island-el)
|
||||
(let ((transform (dom-get-data old-marsh "sx-marsh-transform"))
|
||||
(env (dom-get-data old-marsh "sx-marsh-env"))
|
||||
@@ -555,7 +555,7 @@
|
||||
;;
|
||||
;; Values are JSON-parsed: "7" → 7, "\"hello\"" → "hello", "true" → true.
|
||||
|
||||
(define process-signal-updates
|
||||
(define process-signal-updates :effects [mutation io]
|
||||
(fn (root)
|
||||
(let ((signal-els (dom-query-all root "[data-sx-signal]")))
|
||||
(for-each
|
||||
@@ -576,7 +576,7 @@
|
||||
;; Swap dispatch
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define swap-dom-nodes
|
||||
(define swap-dom-nodes :effects [mutation io]
|
||||
(fn (target new-nodes (strategy :as string))
|
||||
;; Execute a swap strategy on live DOM nodes.
|
||||
;; new-nodes is typically a DocumentFragment or Element.
|
||||
@@ -630,7 +630,7 @@
|
||||
(morph-children target wrapper))))))
|
||||
|
||||
|
||||
(define insert-remaining-siblings
|
||||
(define insert-remaining-siblings :effects [mutation io]
|
||||
(fn (parent ref-node sib)
|
||||
;; Insert sibling chain after ref-node
|
||||
(when sib
|
||||
@@ -643,7 +643,7 @@
|
||||
;; String-based swap (fallback for HTML responses)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define swap-html-string
|
||||
(define swap-html-string :effects [mutation io]
|
||||
(fn (target (html :as string) (strategy :as string))
|
||||
;; Execute a swap strategy using an HTML string (DOMParser pipeline).
|
||||
(case strategy
|
||||
@@ -674,7 +674,7 @@
|
||||
;; History management
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-history
|
||||
(define handle-history :effects [io]
|
||||
(fn (el (url :as string) (resp-headers :as dict))
|
||||
;; Process history push/replace based on element attrs and response headers
|
||||
(let ((push-url (dom-get-attr el "sx-push-url"))
|
||||
@@ -700,7 +700,7 @@
|
||||
|
||||
(define PRELOAD_TTL 30000) ;; 30 seconds
|
||||
|
||||
(define preload-cache-get
|
||||
(define preload-cache-get :effects [mutation]
|
||||
(fn ((cache :as dict) (url :as string))
|
||||
;; Get and consume a cached preload response.
|
||||
;; Returns (dict "text" ... "content-type" ...) or nil.
|
||||
@@ -712,7 +712,7 @@
|
||||
(do (dict-delete! cache url) entry))))))
|
||||
|
||||
|
||||
(define preload-cache-set
|
||||
(define preload-cache-set :effects [mutation]
|
||||
(fn ((cache :as dict) (url :as string) (text :as string) (content-type :as string))
|
||||
;; Store a preloaded response
|
||||
(dict-set! cache url
|
||||
@@ -725,7 +725,7 @@
|
||||
;; Maps trigger event names to binding strategies.
|
||||
;; This is the logic; actual browser event binding is platform interface.
|
||||
|
||||
(define classify-trigger
|
||||
(define classify-trigger :effects []
|
||||
(fn ((trigger :as dict))
|
||||
;; Classify a parsed trigger descriptor for binding.
|
||||
;; Returns one of: "poll", "intersect", "load", "revealed", "event"
|
||||
@@ -742,7 +742,7 @@
|
||||
;; Boost logic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define should-boost-link?
|
||||
(define should-boost-link? :effects [io]
|
||||
(fn (link)
|
||||
;; Whether a link inside an sx-boost container should be boosted
|
||||
(let ((href (dom-get-attr link "href")))
|
||||
@@ -756,7 +756,7 @@
|
||||
(not (dom-has-attr? link "sx-disable"))))))
|
||||
|
||||
|
||||
(define should-boost-form?
|
||||
(define should-boost-form? :effects [io]
|
||||
(fn (form)
|
||||
;; Whether a form inside an sx-boost container should be boosted
|
||||
(and (not (dom-has-attr? form "sx-get"))
|
||||
@@ -768,7 +768,7 @@
|
||||
;; SSE event classification
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-sse-swap
|
||||
(define parse-sse-swap :effects [io]
|
||||
(fn (el)
|
||||
;; Parse sx-sse-swap attribute
|
||||
;; Returns event name to listen for (default "message")
|
||||
|
||||
@@ -55,7 +55,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define trampoline
|
||||
(fn (val)
|
||||
(fn ((val :as any))
|
||||
;; Iteratively resolve thunks until we get an actual value.
|
||||
;; Each target implements thunk? and thunk-expr/thunk-env.
|
||||
(let ((result val))
|
||||
@@ -151,6 +151,8 @@
|
||||
(= name "defpage") (sf-defpage args env)
|
||||
(= name "defquery") (sf-defquery args env)
|
||||
(= name "defaction") (sf-defaction args env)
|
||||
(= name "deftype") (sf-deftype args env)
|
||||
(= name "defeffect") (sf-defeffect args env)
|
||||
(= name "begin") (sf-begin args env)
|
||||
(= name "do") (sf-begin args env)
|
||||
(= name "quote") (sf-quote args env)
|
||||
@@ -506,11 +508,32 @@
|
||||
|
||||
(define sf-define
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Detect :effects keyword: (define name :effects [...] value)
|
||||
(let ((name-sym (first args))
|
||||
(value (trampoline (eval-expr (nth args 1) env))))
|
||||
(has-effects (and (>= (len args) 4)
|
||||
(= (type-of (nth args 1)) "keyword")
|
||||
(= (keyword-name (nth args 1)) "effects")))
|
||||
(val-idx (if (and (>= (len args) 4)
|
||||
(= (type-of (nth args 1)) "keyword")
|
||||
(= (keyword-name (nth args 1)) "effects"))
|
||||
3 1))
|
||||
(value (trampoline (eval-expr (nth args val-idx) env))))
|
||||
(when (and (lambda? value) (nil? (lambda-name value)))
|
||||
(set-lambda-name! value (symbol-name name-sym)))
|
||||
(env-set! env (symbol-name name-sym) value)
|
||||
;; Store effect annotation if declared
|
||||
(when has-effects
|
||||
(let ((effects-raw (nth args 2))
|
||||
(effect-list (if (= (type-of effects-raw) "list")
|
||||
(map (fn (e) (if (= (type-of e) "symbol")
|
||||
(symbol-name e) (str e)))
|
||||
effects-raw)
|
||||
(list (str effects-raw))))
|
||||
(effect-anns (if (env-has? env "*effect-annotations*")
|
||||
(env-get env "*effect-annotations*")
|
||||
(dict))))
|
||||
(dict-set! effect-anns (symbol-name name-sym) effect-list)
|
||||
(env-set! env "*effect-annotations*" effect-anns)))
|
||||
value)))
|
||||
|
||||
|
||||
@@ -528,11 +551,24 @@
|
||||
(has-children (nth parsed 1))
|
||||
(param-types (nth parsed 2))
|
||||
(affinity (defcomp-kwarg args "affinity" "auto")))
|
||||
(let ((comp (make-component comp-name params has-children body env affinity)))
|
||||
(let ((comp (make-component comp-name params has-children body env affinity))
|
||||
(effects (defcomp-kwarg args "effects" nil)))
|
||||
;; Store type annotations if any were declared
|
||||
(when (and (not (nil? param-types))
|
||||
(not (empty? (keys param-types))))
|
||||
(component-set-param-types! comp param-types))
|
||||
;; Store effect annotation if declared
|
||||
(when (not (nil? effects))
|
||||
(let ((effect-list (if (= (type-of effects) "list")
|
||||
(map (fn (e) (if (= (type-of e) "symbol")
|
||||
(symbol-name e) (str e)))
|
||||
effects)
|
||||
(list (str effects))))
|
||||
(effect-anns (if (env-has? env "*effect-annotations*")
|
||||
(env-get env "*effect-annotations*")
|
||||
(dict))))
|
||||
(dict-set! effect-anns (symbol-name name-sym) effect-list)
|
||||
(env-set! env "*effect-annotations*" effect-anns)))
|
||||
(env-set! env (symbol-name name-sym) comp)
|
||||
comp))))
|
||||
|
||||
@@ -654,6 +690,82 @@
|
||||
value)))
|
||||
|
||||
|
||||
;; -- deftype helpers (must be in eval.sx, not types.sx, because
|
||||
;; sf-deftype is always compiled but types.sx is a spec module) --
|
||||
|
||||
(define make-type-def
|
||||
(fn ((name :as string) (params :as list) body)
|
||||
{:name name :params params :body body}))
|
||||
|
||||
(define normalize-type-body
|
||||
(fn (body)
|
||||
;; Convert AST type expressions to type representation.
|
||||
;; Symbols → strings, (union ...) → (or ...), dict keys → strings.
|
||||
(cond
|
||||
(nil? body) "nil"
|
||||
(= (type-of body) "symbol")
|
||||
(symbol-name body)
|
||||
(= (type-of body) "string")
|
||||
body
|
||||
(= (type-of body) "keyword")
|
||||
(keyword-name body)
|
||||
(= (type-of body) "dict")
|
||||
;; Record type — normalize values
|
||||
(map-dict (fn (k v) (normalize-type-body v)) body)
|
||||
(= (type-of body) "list")
|
||||
(if (empty? body) "any"
|
||||
(let ((head (first body)))
|
||||
(let ((head-name (if (= (type-of head) "symbol")
|
||||
(symbol-name head) (str head))))
|
||||
;; (union a b) → (or a b)
|
||||
(if (= head-name "union")
|
||||
(cons "or" (map normalize-type-body (rest body)))
|
||||
;; (or a b), (list-of t), (-> ...) etc.
|
||||
(cons head-name (map normalize-type-body (rest body)))))))
|
||||
:else (str body))))
|
||||
|
||||
(define sf-deftype
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; (deftype name body) or (deftype (name a b ...) body)
|
||||
(let ((name-or-form (first args))
|
||||
(body-expr (nth args 1))
|
||||
(type-name nil)
|
||||
(type-params (list)))
|
||||
;; Parse name — symbol or (symbol params...)
|
||||
(if (= (type-of name-or-form) "symbol")
|
||||
(set! type-name (symbol-name name-or-form))
|
||||
(when (= (type-of name-or-form) "list")
|
||||
(set! type-name (symbol-name (first name-or-form)))
|
||||
(set! type-params
|
||||
(map (fn (p) (if (= (type-of p) "symbol")
|
||||
(symbol-name p) (str p)))
|
||||
(rest name-or-form)))))
|
||||
;; Normalize and store in *type-registry*
|
||||
(let ((body (normalize-type-body body-expr))
|
||||
(registry (if (env-has? env "*type-registry*")
|
||||
(env-get env "*type-registry*")
|
||||
(dict))))
|
||||
(dict-set! registry type-name
|
||||
(make-type-def type-name type-params body))
|
||||
(env-set! env "*type-registry*" registry)
|
||||
nil))))
|
||||
|
||||
|
||||
(define sf-defeffect
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; (defeffect name) — register an effect name
|
||||
(let ((effect-name (if (= (type-of (first args)) "symbol")
|
||||
(symbol-name (first args))
|
||||
(str (first args))))
|
||||
(registry (if (env-has? env "*effect-registry*")
|
||||
(env-get env "*effect-registry*")
|
||||
(list))))
|
||||
(when (not (contains? registry effect-name))
|
||||
(append! registry effect-name))
|
||||
(env-set! env "*effect-registry*" registry)
|
||||
nil)))
|
||||
|
||||
|
||||
(define sf-begin
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(if (empty? args)
|
||||
|
||||
@@ -38,17 +38,66 @@
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defhandler — (defhandler name (&key param...) body)
|
||||
;; defhandler — (defhandler name [:path "..." :method :get :csrf false :returns "element"] (&key param...) body)
|
||||
;;
|
||||
;; Keyword options between name and params list:
|
||||
;; :path — public route path (string). Without :path, handler is internal-only.
|
||||
;; :method — HTTP method (keyword: :get :post :put :patch :delete). Default :get.
|
||||
;; :csrf — CSRF protection (boolean). Default true; set false for POST/PUT etc.
|
||||
;; :returns — return type annotation (types.sx vocabulary). Default "element".
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-handler-args
|
||||
(fn ((args :as list))
|
||||
"Parse defhandler args after the name symbol.
|
||||
Scans for :keyword value option pairs, then a list (params), then body.
|
||||
Returns dict with keys: opts, params, body."
|
||||
(let ((opts {})
|
||||
(params (list))
|
||||
(body nil)
|
||||
(i 0)
|
||||
(n (len args))
|
||||
(done false))
|
||||
(for-each
|
||||
(fn (idx)
|
||||
(when (and (not done) (= idx i))
|
||||
(let ((arg (nth args idx)))
|
||||
(cond
|
||||
;; keyword-value pair → consume two items
|
||||
(= (type-of arg) "keyword")
|
||||
(do
|
||||
(when (< (+ idx 1) n)
|
||||
(let ((val (nth args (+ idx 1))))
|
||||
;; For :method, extract keyword name; for :csrf, keep as-is
|
||||
(dict-set! opts (keyword-name arg)
|
||||
(if (= (type-of val) "keyword")
|
||||
(keyword-name val)
|
||||
val))))
|
||||
(set! i (+ idx 2)))
|
||||
;; list → params, next element is body
|
||||
(= (type-of arg) "list")
|
||||
(do
|
||||
(set! params (parse-key-params arg))
|
||||
(when (< (+ idx 1) n)
|
||||
(set! body (nth args (+ idx 1))))
|
||||
(set! done true))
|
||||
;; anything else → no explicit params, this is body
|
||||
:else
|
||||
(do
|
||||
(set! body arg)
|
||||
(set! done true))))))
|
||||
(range 0 n))
|
||||
(dict :opts opts :params params :body body))))
|
||||
|
||||
(define sf-defhandler
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(params-raw (nth args 1))
|
||||
(body (nth args 2))
|
||||
(name (symbol-name name-sym))
|
||||
(params (parse-key-params params-raw)))
|
||||
(let ((hdef (make-handler-def name params body env)))
|
||||
(parsed (parse-handler-args (rest args)))
|
||||
(opts (get parsed "opts"))
|
||||
(params (get parsed "params"))
|
||||
(body (get parsed "body")))
|
||||
(let ((hdef (make-handler-def name params body env opts)))
|
||||
(env-set! env (str "handler:" name) hdef)
|
||||
hdef))))
|
||||
|
||||
|
||||
@@ -1318,10 +1318,15 @@
|
||||
|
||||
(define js-emit-define
|
||||
(fn (expr)
|
||||
;; Handle (define name :effects [...] value) — skip :effects annotation
|
||||
(let ((name (if (= (type-of (nth expr 1)) "symbol")
|
||||
(symbol-name (nth expr 1))
|
||||
(str (nth expr 1))))
|
||||
(val-expr (nth expr 2)))
|
||||
(val-expr (if (and (>= (len expr) 5)
|
||||
(= (type-of (nth expr 2)) "keyword")
|
||||
(= (keyword-name (nth expr 2)) "effects"))
|
||||
(nth expr 4)
|
||||
(nth expr 2))))
|
||||
(if (nil? val-expr)
|
||||
(str "var " (js-mangle name) " = NIL;")
|
||||
;; Detect zero-arg self-tail-recursive functions → while loops
|
||||
|
||||
@@ -33,7 +33,7 @@
|
||||
;; Event dispatch helpers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispatch-trigger-events
|
||||
(define dispatch-trigger-events :effects [mutation io]
|
||||
(fn (el (header-val :as string))
|
||||
;; Dispatch events from SX-Trigger / SX-Trigger-After-Swap headers.
|
||||
;; Value can be JSON object (name → detail) or comma-separated names.
|
||||
@@ -58,7 +58,7 @@
|
||||
;; CSS tracking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define init-css-tracking
|
||||
(define init-css-tracking :effects [mutation io]
|
||||
(fn ()
|
||||
;; Read initial CSS hash from meta tag
|
||||
(let ((meta (dom-query "meta[name=\"sx-css-classes\"]")))
|
||||
@@ -72,7 +72,7 @@
|
||||
;; Request execution
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define execute-request
|
||||
(define execute-request :effects [mutation io]
|
||||
(fn (el (verbInfo :as dict) (extraParams :as dict))
|
||||
;; Gate checks then delegate to do-fetch.
|
||||
;; verbInfo: dict with "method" and "url" (or nil to read from element).
|
||||
@@ -105,7 +105,7 @@
|
||||
extraParams))))))))))))
|
||||
|
||||
|
||||
(define do-fetch
|
||||
(define do-fetch :effects [mutation io]
|
||||
(fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
|
||||
;; Execute the actual fetch. Manages abort, headers, body, loading state.
|
||||
(let ((sync (dom-get-attr el "sx-sync")))
|
||||
@@ -201,7 +201,7 @@
|
||||
(dict "error" err))))))))))))
|
||||
|
||||
|
||||
(define handle-fetch-success
|
||||
(define handle-fetch-success :effects [mutation io]
|
||||
(fn (el (url :as string) (verb :as string) (extraParams :as dict) get-header (text :as string))
|
||||
;; Route a successful response through the appropriate handler.
|
||||
(let ((resp-headers (process-response-headers get-header)))
|
||||
@@ -269,7 +269,7 @@
|
||||
(dict "target" target-el "swap" swap-style)))))))
|
||||
|
||||
|
||||
(define handle-sx-response
|
||||
(define handle-sx-response :effects [mutation io]
|
||||
(fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
|
||||
;; Handle SX-format response: strip components, extract CSS, render, swap.
|
||||
(let ((cleaned (strip-component-scripts text)))
|
||||
@@ -300,7 +300,7 @@
|
||||
(post-swap target)))))))))))
|
||||
|
||||
|
||||
(define handle-html-response
|
||||
(define handle-html-response :effects [mutation io]
|
||||
(fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
|
||||
;; Handle HTML-format response: parse, OOB, select, swap.
|
||||
(let ((doc (dom-parse-html-document text)))
|
||||
@@ -337,7 +337,7 @@
|
||||
;; Retry
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-retry
|
||||
(define handle-retry :effects [mutation io]
|
||||
(fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
|
||||
;; Handle retry on failure if sx-retry is configured
|
||||
(let ((retry-attr (dom-get-attr el "sx-retry"))
|
||||
@@ -357,7 +357,7 @@
|
||||
;; Trigger binding
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-triggers
|
||||
(define bind-triggers :effects [mutation io]
|
||||
(fn (el (verbInfo :as dict))
|
||||
;; Bind triggers from sx-trigger attribute (or defaults)
|
||||
(let ((triggers (or (parse-trigger-spec (dom-get-attr el "sx-trigger"))
|
||||
@@ -392,7 +392,7 @@
|
||||
triggers))))
|
||||
|
||||
|
||||
(define bind-event
|
||||
(define bind-event :effects [mutation io]
|
||||
(fn (el (event-name :as string) (mods :as dict) (verbInfo :as dict))
|
||||
;; Bind a standard DOM event trigger.
|
||||
;; Handles delay, once, changed, optimistic, preventDefault.
|
||||
@@ -453,7 +453,7 @@
|
||||
;; Post-swap lifecycle
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define post-swap
|
||||
(define post-swap :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Run lifecycle after swap: activate scripts, process SX, hydrate, process
|
||||
(activate-scripts root)
|
||||
@@ -474,7 +474,7 @@
|
||||
;;
|
||||
;; Example: (button :sx-get "/search" :sx-on-settle "(reset! (use-store \"count\") 0)")
|
||||
|
||||
(define process-settle-hooks
|
||||
(define process-settle-hooks :effects [mutation io]
|
||||
(fn (el)
|
||||
(let ((settle-expr (dom-get-attr el "sx-on-settle")))
|
||||
(when (and settle-expr (not (empty? settle-expr)))
|
||||
@@ -484,7 +484,7 @@
|
||||
exprs))))))
|
||||
|
||||
|
||||
(define activate-scripts
|
||||
(define activate-scripts :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Re-activate scripts in swapped content.
|
||||
;; Scripts inserted via innerHTML are inert — clone to make them execute.
|
||||
@@ -505,7 +505,7 @@
|
||||
;; OOB swap processing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-oob-swaps
|
||||
(define process-oob-swaps :effects [mutation io]
|
||||
(fn (container (swap-fn :as lambda))
|
||||
;; Find and process out-of-band swaps in container.
|
||||
;; swap-fn is (fn (target oob-element swap-type) ...).
|
||||
@@ -529,7 +529,7 @@
|
||||
;; Head element hoisting
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define hoist-head-elements
|
||||
(define hoist-head-elements :effects [mutation io]
|
||||
(fn (container)
|
||||
;; Move style[data-sx-css] and link[rel=stylesheet] to <head>
|
||||
;; so they take effect globally.
|
||||
@@ -551,7 +551,7 @@
|
||||
;; Boost processing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-boosted
|
||||
(define process-boosted :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Find [sx-boost] containers and boost their descendants
|
||||
(for-each
|
||||
@@ -560,7 +560,7 @@
|
||||
(dom-query-all (or root (dom-body)) "[sx-boost]"))))
|
||||
|
||||
|
||||
(define boost-descendants
|
||||
(define boost-descendants :effects [mutation io]
|
||||
(fn (container)
|
||||
;; Boost links and forms within a container.
|
||||
;; The sx-boost attribute value is the default target selector
|
||||
@@ -609,7 +609,7 @@
|
||||
(define _page-data-cache (dict))
|
||||
(define _page-data-cache-ttl 30000) ;; 30 seconds in ms
|
||||
|
||||
(define page-data-cache-key
|
||||
(define page-data-cache-key :effects []
|
||||
(fn ((page-name :as string) (params :as dict))
|
||||
;; Build a cache key from page name + params.
|
||||
;; Params are from route matching so order is deterministic.
|
||||
@@ -623,7 +623,7 @@
|
||||
(keys params))
|
||||
(str base ":" (join "&" parts)))))))
|
||||
|
||||
(define page-data-cache-get
|
||||
(define page-data-cache-get :effects [mutation io]
|
||||
(fn ((cache-key :as string))
|
||||
;; Return cached data if fresh, else nil.
|
||||
(let ((entry (get _page-data-cache cache-key)))
|
||||
@@ -635,7 +635,7 @@
|
||||
nil)
|
||||
(get entry "data"))))))
|
||||
|
||||
(define page-data-cache-set
|
||||
(define page-data-cache-set :effects [mutation io]
|
||||
(fn ((cache-key :as string) data)
|
||||
;; Store data with current timestamp.
|
||||
(dict-set! _page-data-cache cache-key
|
||||
@@ -646,7 +646,7 @@
|
||||
;; Client-side routing — cache management
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define invalidate-page-cache
|
||||
(define invalidate-page-cache :effects [mutation io]
|
||||
(fn ((page-name :as string))
|
||||
;; Clear cached data for a page. Removes all cache entries whose key
|
||||
;; matches page-name (exact) or starts with "page-name:" (with params).
|
||||
@@ -659,14 +659,14 @@
|
||||
(sw-post-message {"type" "invalidate" "page" page-name})
|
||||
(log-info (str "sx:cache invalidate " page-name))))
|
||||
|
||||
(define invalidate-all-page-cache
|
||||
(define invalidate-all-page-cache :effects [mutation io]
|
||||
(fn ()
|
||||
;; Clear all cached page data and notify service worker.
|
||||
(set! _page-data-cache (dict))
|
||||
(sw-post-message {"type" "invalidate" "page" "*"})
|
||||
(log-info "sx:cache invalidate *")))
|
||||
|
||||
(define update-page-cache
|
||||
(define update-page-cache :effects [mutation io]
|
||||
(fn ((page-name :as string) data)
|
||||
;; Replace cached data for a page with server-provided data.
|
||||
;; Uses a bare page-name key (no params) — the server knows the
|
||||
@@ -675,7 +675,7 @@
|
||||
(page-data-cache-set cache-key data)
|
||||
(log-info (str "sx:cache update " page-name)))))
|
||||
|
||||
(define process-cache-directives
|
||||
(define process-cache-directives :effects [mutation io]
|
||||
(fn (el (resp-headers :as dict) (response-text :as string))
|
||||
;; Process cache invalidation and update directives from both
|
||||
;; element attributes and response headers.
|
||||
@@ -721,7 +721,7 @@
|
||||
|
||||
(define _optimistic-snapshots (dict))
|
||||
|
||||
(define optimistic-cache-update
|
||||
(define optimistic-cache-update :effects [mutation]
|
||||
(fn ((cache-key :as string) (mutator :as lambda))
|
||||
;; Apply predicted mutation to cached data. Saves snapshot for rollback.
|
||||
;; Returns predicted data or nil if no cached data exists.
|
||||
@@ -734,7 +734,7 @@
|
||||
(page-data-cache-set cache-key predicted)
|
||||
predicted)))))
|
||||
|
||||
(define optimistic-cache-revert
|
||||
(define optimistic-cache-revert :effects [mutation]
|
||||
(fn ((cache-key :as string))
|
||||
;; Revert to pre-mutation snapshot. Returns restored data or nil.
|
||||
(let ((snapshot (get _optimistic-snapshots cache-key)))
|
||||
@@ -743,12 +743,12 @@
|
||||
(dict-delete! _optimistic-snapshots cache-key)
|
||||
snapshot))))
|
||||
|
||||
(define optimistic-cache-confirm
|
||||
(define optimistic-cache-confirm :effects [mutation]
|
||||
(fn ((cache-key :as string))
|
||||
;; Server accepted — discard the rollback snapshot.
|
||||
(dict-delete! _optimistic-snapshots cache-key)))
|
||||
|
||||
(define submit-mutation
|
||||
(define submit-mutation :effects [mutation io]
|
||||
(fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
|
||||
;; Optimistic mutation: predict locally, send to server, confirm or revert.
|
||||
;; on-complete is called with "confirmed" or "reverted" status.
|
||||
@@ -787,14 +787,14 @@
|
||||
(define _is-online true)
|
||||
(define _offline-queue (list))
|
||||
|
||||
(define offline-is-online?
|
||||
(define offline-is-online? :effects [io]
|
||||
(fn () _is-online))
|
||||
|
||||
(define offline-set-online!
|
||||
(define offline-set-online! :effects [mutation]
|
||||
(fn ((val :as boolean))
|
||||
(set! _is-online val)))
|
||||
|
||||
(define offline-queue-mutation
|
||||
(define offline-queue-mutation :effects [mutation io]
|
||||
(fn ((action-name :as string) payload (page-name :as string) (params :as dict) (mutator-fn :as lambda))
|
||||
;; Queue a mutation for later sync. Apply optimistic update locally.
|
||||
(let ((cache-key (page-data-cache-key page-name params))
|
||||
@@ -813,7 +813,7 @@
|
||||
(log-info (str "sx:offline queued " action-name " (" (len _offline-queue) " pending)"))
|
||||
entry)))
|
||||
|
||||
(define offline-sync
|
||||
(define offline-sync :effects [mutation io]
|
||||
(fn ()
|
||||
;; Replay all pending mutations. Called on reconnect.
|
||||
(let ((pending (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue)))
|
||||
@@ -830,11 +830,11 @@
|
||||
(log-warn (str "sx:offline sync failed " (get entry "action") ": " error)))))
|
||||
pending)))))
|
||||
|
||||
(define offline-pending-count
|
||||
(define offline-pending-count :effects [io]
|
||||
(fn ()
|
||||
(len (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue))))
|
||||
|
||||
(define offline-aware-mutation
|
||||
(define offline-aware-mutation :effects [mutation io]
|
||||
(fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
|
||||
;; Top-level mutation function. Routes to submit-mutation when online,
|
||||
;; offline-queue-mutation when offline.
|
||||
@@ -849,7 +849,7 @@
|
||||
;; Client-side routing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define current-page-layout
|
||||
(define current-page-layout :effects [io]
|
||||
(fn ()
|
||||
;; Find the layout name of the currently displayed page by matching
|
||||
;; the browser URL against the page route table.
|
||||
@@ -859,7 +859,7 @@
|
||||
(or (get match "layout") "")))))
|
||||
|
||||
|
||||
(define swap-rendered-content
|
||||
(define swap-rendered-content :effects [mutation io]
|
||||
(fn (target rendered (pathname :as string))
|
||||
;; Swap rendered DOM content into target and run post-processing.
|
||||
;; Shared by pure and data page client routes.
|
||||
@@ -875,7 +875,7 @@
|
||||
(log-info (str "sx:route client " pathname)))))
|
||||
|
||||
|
||||
(define resolve-route-target
|
||||
(define resolve-route-target :effects [io]
|
||||
(fn ((target-sel :as string))
|
||||
;; Resolve a target selector to a DOM element, or nil.
|
||||
(if (and target-sel (not (= target-sel "true")))
|
||||
@@ -883,7 +883,7 @@
|
||||
nil)))
|
||||
|
||||
|
||||
(define deps-satisfied?
|
||||
(define deps-satisfied? :effects [io]
|
||||
(fn ((match :as dict))
|
||||
;; Check if all component deps for a page are loaded client-side.
|
||||
(let ((deps (get match "deps"))
|
||||
@@ -893,7 +893,7 @@
|
||||
(every? (fn ((dep :as string)) (contains? loaded dep)) deps)))))
|
||||
|
||||
|
||||
(define try-client-route
|
||||
(define try-client-route :effects [mutation io]
|
||||
(fn ((pathname :as string) (target-sel :as string))
|
||||
;; Try to render a page client-side. Returns true if successful, false otherwise.
|
||||
;; target-sel is the CSS selector for the swap target (from sx-boost value).
|
||||
@@ -1011,7 +1011,7 @@
|
||||
true))))))))))))))))))
|
||||
|
||||
|
||||
(define bind-client-route-link
|
||||
(define bind-client-route-link :effects [mutation io]
|
||||
(fn (link (href :as string))
|
||||
;; Bind a boost link with client-side routing. If the route can be
|
||||
;; rendered client-side (pure page, no :data), do so. Otherwise
|
||||
@@ -1026,7 +1026,7 @@
|
||||
;; SSE processing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-sse
|
||||
(define process-sse :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Find and bind SSE elements
|
||||
(for-each
|
||||
@@ -1037,7 +1037,7 @@
|
||||
(dom-query-all (or root (dom-body)) "[sx-sse]"))))
|
||||
|
||||
|
||||
(define bind-sse
|
||||
(define bind-sse :effects [mutation io]
|
||||
(fn (el)
|
||||
;; Connect to SSE endpoint and bind swap handler
|
||||
(let ((url (dom-get-attr el "sx-sse")))
|
||||
@@ -1049,7 +1049,7 @@
|
||||
(bind-sse-swap el data))))))))
|
||||
|
||||
|
||||
(define bind-sse-swap
|
||||
(define bind-sse-swap :effects [mutation io]
|
||||
(fn (el (data :as string))
|
||||
;; Handle an SSE event: swap data into element
|
||||
(let ((target (resolve-target el))
|
||||
@@ -1081,7 +1081,7 @@
|
||||
;; Inline event handlers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-inline-handlers
|
||||
(define bind-inline-handlers :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Find elements with sx-on:* attributes and bind SX event handlers.
|
||||
;; Handler bodies are SX expressions evaluated with `event` and `this`
|
||||
@@ -1115,7 +1115,7 @@
|
||||
;; Preload
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-preload-for
|
||||
(define bind-preload-for :effects [mutation io]
|
||||
(fn (el)
|
||||
;; Bind preload event listeners based on sx-preload attribute
|
||||
(let ((preload-attr (dom-get-attr el "sx-preload")))
|
||||
@@ -1134,7 +1134,7 @@
|
||||
(loaded-component-names) _css-hash)))))))))))
|
||||
|
||||
|
||||
(define do-preload
|
||||
(define do-preload :effects [mutation io]
|
||||
(fn ((url :as string) (headers :as dict))
|
||||
;; Execute a preload fetch into the cache
|
||||
(when (nil? (preload-cache-get _preload-cache url))
|
||||
@@ -1148,7 +1148,7 @@
|
||||
(define VERB_SELECTOR
|
||||
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
|
||||
|
||||
(define process-elements
|
||||
(define process-elements :effects [mutation io]
|
||||
(fn (root)
|
||||
;; Find all elements with sx-* verb attributes and process them.
|
||||
(let ((els (dom-query-all (or root (dom-body)) VERB_SELECTOR)))
|
||||
@@ -1165,7 +1165,7 @@
|
||||
(process-emit-elements root)))
|
||||
|
||||
|
||||
(define process-one
|
||||
(define process-one :effects [mutation io]
|
||||
(fn (el)
|
||||
;; Process a single element with an sx-* verb attribute
|
||||
(let ((verb-info (get-verb-info el)))
|
||||
@@ -1193,7 +1193,7 @@
|
||||
;; On click → dispatches CustomEvent "cart:add" with detail {id:42, name:"Widget"}
|
||||
;; The event bubbles up to the island container where bridge-event catches it.
|
||||
|
||||
(define process-emit-elements
|
||||
(define process-emit-elements :effects [mutation io]
|
||||
(fn (root)
|
||||
(let ((els (dom-query-all (or root (dom-body)) "[data-sx-emit]")))
|
||||
(for-each
|
||||
@@ -1214,7 +1214,7 @@
|
||||
;; History: popstate handler
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-popstate
|
||||
(define handle-popstate :effects [mutation io]
|
||||
(fn ((scrollY :as number))
|
||||
;; Handle browser back/forward navigation.
|
||||
;; Derive target from [sx-boost] container or fall back to #main-panel.
|
||||
@@ -1241,7 +1241,7 @@
|
||||
;; Initialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define engine-init
|
||||
(define engine-init :effects [mutation io]
|
||||
(fn ()
|
||||
;; Initialize: CSS tracking, scripts, hydrate, process.
|
||||
(do
|
||||
|
||||
@@ -49,20 +49,20 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Returns a list of top-level AST expressions.
|
||||
|
||||
(define sx-parse
|
||||
(define sx-parse :effects []
|
||||
(fn ((source :as string))
|
||||
(let ((pos 0)
|
||||
(len-src (len source)))
|
||||
|
||||
;; -- Cursor helpers (closure over pos, source, len-src) --
|
||||
|
||||
(define skip-comment
|
||||
(define skip-comment :effects []
|
||||
(fn ()
|
||||
(when (and (< pos len-src) (not (= (nth source pos) "\n")))
|
||||
(set! pos (inc pos))
|
||||
(skip-comment))))
|
||||
|
||||
(define skip-ws
|
||||
(define skip-ws :effects []
|
||||
(fn ()
|
||||
(when (< pos len-src)
|
||||
(let ((ch (nth source pos)))
|
||||
@@ -80,11 +80,11 @@
|
||||
|
||||
;; -- Atom readers --
|
||||
|
||||
(define read-string
|
||||
(define read-string :effects []
|
||||
(fn ()
|
||||
(set! pos (inc pos)) ;; skip opening "
|
||||
(let ((buf ""))
|
||||
(define read-str-loop
|
||||
(define read-str-loop :effects []
|
||||
(fn ()
|
||||
(if (>= pos len-src)
|
||||
(error "Unterminated string")
|
||||
@@ -110,10 +110,10 @@
|
||||
(read-str-loop)
|
||||
buf)))
|
||||
|
||||
(define read-ident
|
||||
(define read-ident :effects []
|
||||
(fn ()
|
||||
(let ((start pos))
|
||||
(define read-ident-loop
|
||||
(define read-ident-loop :effects []
|
||||
(fn ()
|
||||
(when (and (< pos len-src)
|
||||
(ident-char? (nth source pos)))
|
||||
@@ -122,19 +122,19 @@
|
||||
(read-ident-loop)
|
||||
(slice source start pos))))
|
||||
|
||||
(define read-keyword
|
||||
(define read-keyword :effects []
|
||||
(fn ()
|
||||
(set! pos (inc pos)) ;; skip :
|
||||
(make-keyword (read-ident))))
|
||||
|
||||
(define read-number
|
||||
(define read-number :effects []
|
||||
(fn ()
|
||||
(let ((start pos))
|
||||
;; Optional leading minus
|
||||
(when (and (< pos len-src) (= (nth source pos) "-"))
|
||||
(set! pos (inc pos)))
|
||||
;; Integer digits
|
||||
(define read-digits
|
||||
(define read-digits :effects []
|
||||
(fn ()
|
||||
(when (and (< pos len-src)
|
||||
(let ((c (nth source pos)))
|
||||
@@ -158,7 +158,7 @@
|
||||
(read-digits))
|
||||
(parse-number (slice source start pos)))))
|
||||
|
||||
(define read-symbol
|
||||
(define read-symbol :effects []
|
||||
(fn ()
|
||||
(let ((name (read-ident)))
|
||||
(cond
|
||||
@@ -169,10 +169,10 @@
|
||||
|
||||
;; -- Composite readers --
|
||||
|
||||
(define read-list
|
||||
(define read-list :effects []
|
||||
(fn ((close-ch :as string))
|
||||
(let ((items (list)))
|
||||
(define read-list-loop
|
||||
(define read-list-loop :effects []
|
||||
(fn ()
|
||||
(skip-ws)
|
||||
(if (>= pos len-src)
|
||||
@@ -184,10 +184,10 @@
|
||||
(read-list-loop)
|
||||
items)))
|
||||
|
||||
(define read-map
|
||||
(define read-map :effects []
|
||||
(fn ()
|
||||
(let ((result (dict)))
|
||||
(define read-map-loop
|
||||
(define read-map-loop :effects []
|
||||
(fn ()
|
||||
(skip-ws)
|
||||
(if (>= pos len-src)
|
||||
@@ -206,10 +206,10 @@
|
||||
|
||||
;; -- Raw string reader (for #|...|) --
|
||||
|
||||
(define read-raw-string
|
||||
(define read-raw-string :effects []
|
||||
(fn ()
|
||||
(let ((buf ""))
|
||||
(define raw-loop
|
||||
(define raw-loop :effects []
|
||||
(fn ()
|
||||
(if (>= pos len-src)
|
||||
(error "Unterminated raw string")
|
||||
@@ -224,7 +224,7 @@
|
||||
|
||||
;; -- Main expression reader --
|
||||
|
||||
(define read-expr
|
||||
(define read-expr :effects []
|
||||
(fn ()
|
||||
(skip-ws)
|
||||
(if (>= pos len-src)
|
||||
@@ -322,7 +322,7 @@
|
||||
|
||||
;; -- Entry point: parse all top-level expressions --
|
||||
(let ((exprs (list)))
|
||||
(define parse-loop
|
||||
(define parse-loop :effects []
|
||||
(fn ()
|
||||
(skip-ws)
|
||||
(when (< pos len-src)
|
||||
@@ -336,7 +336,7 @@
|
||||
;; Serializer — AST → SX source text
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-serialize
|
||||
(define sx-serialize :effects []
|
||||
(fn (val)
|
||||
(case (type-of val)
|
||||
"nil" "nil"
|
||||
@@ -351,7 +351,7 @@
|
||||
:else (str val))))
|
||||
|
||||
|
||||
(define sx-serialize-dict
|
||||
(define sx-serialize-dict :effects []
|
||||
(fn ((d :as dict))
|
||||
(str "{"
|
||||
(join " "
|
||||
|
||||
@@ -222,8 +222,15 @@ def make_macro(params, rest_param, body, env, name=None):
|
||||
closure=dict(env), name=name)
|
||||
|
||||
|
||||
def make_handler_def(name, params, body, env):
|
||||
return HandlerDef(name=name, params=list(params), body=body, closure=dict(env))
|
||||
def make_handler_def(name, params, body, env, opts=None):
|
||||
path = opts.get('path') if opts else None
|
||||
method = str(opts.get('method', 'get')) if opts else 'get'
|
||||
csrf = opts.get('csrf', True) if opts else True
|
||||
returns = str(opts.get('returns', 'element')) if opts else 'element'
|
||||
if isinstance(csrf, str):
|
||||
csrf = csrf.lower() not in ('false', 'nil', 'no')
|
||||
return HandlerDef(name=name, params=list(params), body=body, closure=dict(env),
|
||||
path=path, method=method.lower(), csrf=csrf, returns=returns)
|
||||
|
||||
|
||||
def make_query_def(name, params, doc, body, env):
|
||||
@@ -575,6 +582,11 @@ def strip_prefix(s, prefix):
|
||||
return s[len(prefix):] if s.startswith(prefix) else s
|
||||
|
||||
|
||||
def debug_log(*args):
|
||||
import sys
|
||||
print(*args, file=sys.stderr)
|
||||
|
||||
|
||||
def error(msg):
|
||||
raise EvalError(msg)
|
||||
|
||||
|
||||
@@ -70,6 +70,17 @@
|
||||
:doc "Modulo a % b."
|
||||
:body (native-mod a b))
|
||||
|
||||
(define-primitive "random-int"
|
||||
:params ((low :as number) (high :as number))
|
||||
:returns "number"
|
||||
:doc "Random integer in [low, high] inclusive."
|
||||
:body (native-random-int low high))
|
||||
|
||||
(define-primitive "json-encode"
|
||||
:params (value)
|
||||
:returns "string"
|
||||
:doc "Encode value as JSON string with indentation.")
|
||||
|
||||
(define-primitive "sqrt"
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
|
||||
@@ -71,13 +71,14 @@
|
||||
;; Shared utilities
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define definition-form?
|
||||
(define definition-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(or (= name "define") (= name "defcomp") (= name "defisland")
|
||||
(= name "defmacro") (= name "defstyle") (= name "defhandler"))))
|
||||
(= name "defmacro") (= name "defstyle") (= name "defhandler")
|
||||
(= name "deftype") (= name "defeffect"))))
|
||||
|
||||
|
||||
(define parse-element-args
|
||||
(define parse-element-args :effects [render]
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list)
|
||||
(let ((attrs (dict))
|
||||
@@ -100,7 +101,7 @@
|
||||
(list attrs children))))
|
||||
|
||||
|
||||
(define render-attrs
|
||||
(define render-attrs :effects []
|
||||
(fn ((attrs :as dict))
|
||||
;; Render an attrs dict to an HTML attribute string.
|
||||
;; Used by adapter-html.sx and adapter-sx.sx.
|
||||
@@ -132,13 +133,13 @@
|
||||
;; eval-cond: find matching cond branch, return unevaluated body expr.
|
||||
;; Handles both scheme-style ((test body) ...) and clojure-style
|
||||
;; (test body test body ...).
|
||||
(define eval-cond
|
||||
(define eval-cond :effects []
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (cond-scheme? clauses)
|
||||
(eval-cond-scheme clauses env)
|
||||
(eval-cond-clojure clauses env))))
|
||||
|
||||
(define eval-cond-scheme
|
||||
(define eval-cond-scheme :effects []
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (empty? clauses)
|
||||
nil
|
||||
@@ -155,7 +156,7 @@
|
||||
body
|
||||
(eval-cond-scheme (rest clauses) env)))))))
|
||||
|
||||
(define eval-cond-clojure
|
||||
(define eval-cond-clojure :effects []
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
@@ -172,7 +173,7 @@
|
||||
|
||||
;; process-bindings: evaluate let-binding pairs, return extended env.
|
||||
;; bindings = ((name1 expr1) (name2 expr2) ...)
|
||||
(define process-bindings
|
||||
(define process-bindings :effects [mutation]
|
||||
(fn ((bindings :as list) (env :as dict))
|
||||
;; env-extend (not merge) — Env is not a dict subclass, so merge()
|
||||
;; returns an empty dict, losing all parent scope bindings.
|
||||
@@ -194,7 +195,7 @@
|
||||
;; Used by eval-list to dispatch rendering forms to the active adapter
|
||||
;; (HTML, SX wire, or DOM) rather than evaluating them as function calls.
|
||||
|
||||
(define is-render-expr?
|
||||
(define is-render-expr? :effects []
|
||||
(fn (expr)
|
||||
(if (or (not (= (type-of expr) "list")) (empty? expr))
|
||||
false
|
||||
|
||||
@@ -17,7 +17,7 @@
|
||||
;; "/" → ()
|
||||
;; "/docs/" → ("docs")
|
||||
|
||||
(define split-path-segments
|
||||
(define split-path-segments :effects []
|
||||
(fn ((path :as string))
|
||||
(let ((trimmed (if (starts-with? path "/") (slice path 1) path)))
|
||||
(let ((trimmed2 (if (and (not (empty? trimmed))
|
||||
@@ -35,7 +35,7 @@
|
||||
;; "/docs/<slug>" → ({"type" "literal" "value" "docs"}
|
||||
;; {"type" "param" "value" "slug"})
|
||||
|
||||
(define make-route-segment
|
||||
(define make-route-segment :effects []
|
||||
(fn ((seg :as string))
|
||||
(if (and (starts-with? seg "<") (ends-with? seg ">"))
|
||||
(let ((param-name (slice seg 1 (- (len seg) 1))))
|
||||
@@ -48,7 +48,7 @@
|
||||
(dict-set! d "value" seg)
|
||||
d))))
|
||||
|
||||
(define parse-route-pattern
|
||||
(define parse-route-pattern :effects []
|
||||
(fn ((pattern :as string))
|
||||
(let ((segments (split-path-segments pattern)))
|
||||
(map make-route-segment segments))))
|
||||
@@ -59,7 +59,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Returns params dict if match, nil if no match.
|
||||
|
||||
(define match-route-segments
|
||||
(define match-route-segments :effects []
|
||||
(fn ((path-segs :as list) (parsed-segs :as list))
|
||||
(if (not (= (len path-segs) (len parsed-segs)))
|
||||
nil
|
||||
@@ -87,7 +87,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Returns params dict (may be empty for exact matches) or nil.
|
||||
|
||||
(define match-route
|
||||
(define match-route :effects []
|
||||
(fn ((path :as string) (pattern :as string))
|
||||
(let ((path-segs (split-path-segments path))
|
||||
(parsed-segs (parse-route-pattern pattern)))
|
||||
@@ -100,7 +100,7 @@
|
||||
;; Each entry: {"pattern" "/docs/<slug>" "parsed" [...] "name" "docs-page" ...}
|
||||
;; Returns matching entry with "params" added, or nil.
|
||||
|
||||
(define find-matching-route
|
||||
(define find-matching-route :effects []
|
||||
(fn ((path :as string) (routes :as list))
|
||||
(let ((path-segs (split-path-segments path))
|
||||
(result nil))
|
||||
|
||||
180
shared/sx/ref/run_type_tests.py
Normal file
180
shared/sx/ref/run_type_tests.py
Normal file
@@ -0,0 +1,180 @@
|
||||
#!/usr/bin/env python3
|
||||
"""Run test-types.sx using the bootstrapped evaluator with types module loaded."""
|
||||
from __future__ import annotations
|
||||
import os, sys
|
||||
|
||||
_HERE = os.path.dirname(os.path.abspath(__file__))
|
||||
_PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.ref.sx_ref import eval_expr, trampoline, make_env
|
||||
from shared.sx.types import NIL, Component
|
||||
|
||||
# Build env with primitives
|
||||
env = make_env()
|
||||
|
||||
# Platform test functions
|
||||
_suite_stack: list[str] = []
|
||||
_pass_count = 0
|
||||
_fail_count = 0
|
||||
|
||||
def _try_call(thunk):
|
||||
try:
|
||||
trampoline(eval_expr([thunk], env)) # call the thunk
|
||||
return {"ok": True}
|
||||
except Exception as e:
|
||||
return {"ok": False, "error": str(e)}
|
||||
|
||||
def _report_pass(name):
|
||||
global _pass_count
|
||||
_pass_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" PASS: {ctx} > {name}")
|
||||
return NIL
|
||||
|
||||
def _report_fail(name, error):
|
||||
global _fail_count
|
||||
_fail_count += 1
|
||||
ctx = " > ".join(_suite_stack)
|
||||
print(f" FAIL: {ctx} > {name}: {error}")
|
||||
return NIL
|
||||
|
||||
def _push_suite(name):
|
||||
_suite_stack.append(name)
|
||||
print(f"{' ' * (len(_suite_stack)-1)}Suite: {name}")
|
||||
return NIL
|
||||
|
||||
def _pop_suite():
|
||||
if _suite_stack:
|
||||
_suite_stack.pop()
|
||||
return NIL
|
||||
|
||||
env["try-call"] = _try_call
|
||||
env["report-pass"] = _report_pass
|
||||
env["report-fail"] = _report_fail
|
||||
env["push-suite"] = _push_suite
|
||||
env["pop-suite"] = _pop_suite
|
||||
|
||||
# Test fixtures — provide the functions that tests expect
|
||||
|
||||
# test-prim-types: dict of primitive return types for type inference
|
||||
def _test_prim_types():
|
||||
return {
|
||||
"+": "number", "-": "number", "*": "number", "/": "number",
|
||||
"mod": "number", "inc": "number", "dec": "number",
|
||||
"abs": "number", "min": "number", "max": "number",
|
||||
"floor": "number", "ceil": "number", "round": "number",
|
||||
"str": "string", "upper": "string", "lower": "string",
|
||||
"trim": "string", "join": "string", "replace": "string",
|
||||
"format": "string", "substr": "string",
|
||||
"=": "boolean", "<": "boolean", ">": "boolean",
|
||||
"<=": "boolean", ">=": "boolean", "!=": "boolean",
|
||||
"not": "boolean", "nil?": "boolean", "empty?": "boolean",
|
||||
"number?": "boolean", "string?": "boolean", "boolean?": "boolean",
|
||||
"list?": "boolean", "dict?": "boolean", "symbol?": "boolean",
|
||||
"keyword?": "boolean", "contains?": "boolean", "has-key?": "boolean",
|
||||
"starts-with?": "boolean", "ends-with?": "boolean",
|
||||
"len": "number", "first": "any", "rest": "list",
|
||||
"last": "any", "nth": "any", "cons": "list",
|
||||
"append": "list", "concat": "list", "reverse": "list",
|
||||
"sort": "list", "slice": "list", "range": "list",
|
||||
"flatten": "list", "keys": "list", "vals": "list",
|
||||
"map-dict": "dict", "assoc": "dict", "dissoc": "dict",
|
||||
"merge": "dict", "dict": "dict",
|
||||
"get": "any", "type-of": "string",
|
||||
}
|
||||
|
||||
# test-prim-param-types: dict of primitive param type specs
|
||||
# Format: {name → {"positional" [["name" "type"] ...] "rest-type" type-or-nil}}
|
||||
def _test_prim_param_types():
|
||||
return {
|
||||
"+": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"-": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"*": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"/": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"inc": {"positional": [["n", "number"]], "rest-type": NIL},
|
||||
"dec": {"positional": [["n", "number"]], "rest-type": NIL},
|
||||
"upper": {"positional": [["s", "string"]], "rest-type": NIL},
|
||||
"lower": {"positional": [["s", "string"]], "rest-type": NIL},
|
||||
"keys": {"positional": [["d", "dict"]], "rest-type": NIL},
|
||||
"vals": {"positional": [["d", "dict"]], "rest-type": NIL},
|
||||
}
|
||||
|
||||
# test-env: returns a fresh env for use in tests (same as the test env)
|
||||
def _test_env():
|
||||
return env
|
||||
|
||||
# sx-parse: parse an SX string and return list of AST nodes
|
||||
def _sx_parse(source):
|
||||
return parse_all(source)
|
||||
|
||||
# dict-get: used in some legacy tests
|
||||
def _dict_get(d, k):
|
||||
v = d.get(k) if isinstance(d, dict) else NIL
|
||||
return v if v is not None else NIL
|
||||
|
||||
# component-set-param-types! and component-param-types: type annotation accessors
|
||||
def _component_set_param_types(comp, types_dict):
|
||||
comp.param_types = types_dict
|
||||
return NIL
|
||||
|
||||
def _component_param_types(comp):
|
||||
return getattr(comp, 'param_types', NIL)
|
||||
|
||||
# Platform functions used by types.sx but not SX primitives
|
||||
def _component_params(c):
|
||||
return c.params
|
||||
|
||||
def _component_body(c):
|
||||
return c.body
|
||||
|
||||
def _component_has_children(c):
|
||||
return c.has_children
|
||||
|
||||
def _map_dict(fn, d):
|
||||
from shared.sx.types import Lambda as _Lambda
|
||||
result = {}
|
||||
for k, v in d.items():
|
||||
if isinstance(fn, _Lambda):
|
||||
# Call SX lambda through the evaluator
|
||||
result[k] = trampoline(eval_expr([fn, k, v], env))
|
||||
else:
|
||||
result[k] = fn(k, v)
|
||||
return result
|
||||
|
||||
env["test-prim-types"] = _test_prim_types
|
||||
env["test-prim-param-types"] = _test_prim_param_types
|
||||
env["test-env"] = _test_env
|
||||
env["sx-parse"] = _sx_parse
|
||||
env["dict-get"] = _dict_get
|
||||
env["component-set-param-types!"] = _component_set_param_types
|
||||
env["component-param-types"] = _component_param_types
|
||||
env["component-params"] = _component_params
|
||||
env["component-body"] = _component_body
|
||||
env["component-has-children"] = _component_has_children
|
||||
env["map-dict"] = _map_dict
|
||||
|
||||
# Load test framework (macros + assertion helpers)
|
||||
with open(os.path.join(_HERE, "test-framework.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Load types module
|
||||
with open(os.path.join(_HERE, "types.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
# Run tests
|
||||
print("=" * 60)
|
||||
print("Running test-types.sx")
|
||||
print("=" * 60)
|
||||
|
||||
with open(os.path.join(_HERE, "test-types.sx")) as f:
|
||||
for expr in parse_all(f.read()):
|
||||
trampoline(eval_expr(expr, env))
|
||||
|
||||
print("=" * 60)
|
||||
print(f"Results: {_pass_count} passed, {_fail_count} failed")
|
||||
print("=" * 60)
|
||||
sys.exit(1 if _fail_count > 0 else 0)
|
||||
@@ -41,8 +41,8 @@
|
||||
;; 1. signal — create a reactive container
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define signal
|
||||
(fn (initial-value)
|
||||
(define signal :effects []
|
||||
(fn ((initial-value :as any))
|
||||
(make-signal initial-value)))
|
||||
|
||||
|
||||
@@ -54,8 +54,8 @@
|
||||
;; signal as a dependency. Outside reactive context, deref just returns
|
||||
;; the current value — no subscription, no overhead.
|
||||
|
||||
(define deref
|
||||
(fn (s)
|
||||
(define deref :effects []
|
||||
(fn ((s :as any))
|
||||
(if (not (signal? s))
|
||||
s ;; non-signal values pass through
|
||||
(let ((ctx (get-tracking-context)))
|
||||
@@ -71,7 +71,7 @@
|
||||
;; 3. reset! — write a new value, notify subscribers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define reset!
|
||||
(define reset! :effects [mutation]
|
||||
(fn ((s :as signal) value)
|
||||
(when (signal? s)
|
||||
(let ((old (signal-value s)))
|
||||
@@ -84,7 +84,7 @@
|
||||
;; 4. swap! — update signal via function
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define swap!
|
||||
(define swap! :effects [mutation]
|
||||
(fn ((s :as signal) (f :as lambda) &rest args)
|
||||
(when (signal? s)
|
||||
(let ((old (signal-value s))
|
||||
@@ -102,7 +102,7 @@
|
||||
;; of its dependencies change. The dependency set is discovered automatically
|
||||
;; by tracking deref calls during evaluation.
|
||||
|
||||
(define computed
|
||||
(define computed :effects [mutation]
|
||||
(fn ((compute-fn :as lambda))
|
||||
(let ((s (make-signal nil))
|
||||
(deps (list))
|
||||
@@ -145,7 +145,7 @@
|
||||
;; Like computed, but doesn't produce a signal value. Returns a dispose
|
||||
;; function that tears down the effect.
|
||||
|
||||
(define effect
|
||||
(define effect :effects [mutation]
|
||||
(fn ((effect-fn :as lambda))
|
||||
(let ((deps (list))
|
||||
(disposed false)
|
||||
@@ -201,7 +201,7 @@
|
||||
(define *batch-depth* 0)
|
||||
(define *batch-queue* (list))
|
||||
|
||||
(define batch
|
||||
(define batch :effects [mutation]
|
||||
(fn ((thunk :as lambda))
|
||||
(set! *batch-depth* (+ *batch-depth* 1))
|
||||
(invoke thunk)
|
||||
@@ -231,14 +231,14 @@
|
||||
;;
|
||||
;; If inside a batch, queues the signal. Otherwise, notifies immediately.
|
||||
|
||||
(define notify-subscribers
|
||||
(define notify-subscribers :effects [mutation]
|
||||
(fn ((s :as signal))
|
||||
(if (> *batch-depth* 0)
|
||||
(when (not (contains? *batch-queue* s))
|
||||
(append! *batch-queue* s))
|
||||
(flush-subscribers s))))
|
||||
|
||||
(define flush-subscribers
|
||||
(define flush-subscribers :effects [mutation]
|
||||
(fn ((s :as signal))
|
||||
(for-each
|
||||
(fn ((sub :as lambda)) (sub))
|
||||
@@ -268,7 +268,7 @@
|
||||
;; For computed signals, unsubscribe from all dependencies.
|
||||
;; For effects, the dispose function is returned by effect itself.
|
||||
|
||||
(define dispose-computed
|
||||
(define dispose-computed :effects [mutation]
|
||||
(fn ((s :as signal))
|
||||
(when (signal? s)
|
||||
(for-each
|
||||
@@ -287,7 +287,7 @@
|
||||
|
||||
(define *island-scope* nil)
|
||||
|
||||
(define with-island-scope
|
||||
(define with-island-scope :effects [mutation]
|
||||
(fn ((scope-fn :as lambda) (body-fn :as lambda))
|
||||
(let ((prev *island-scope*))
|
||||
(set! *island-scope* scope-fn)
|
||||
@@ -299,7 +299,7 @@
|
||||
;; The platform's make-signal should call (register-in-scope s) if
|
||||
;; *island-scope* is non-nil.
|
||||
|
||||
(define register-in-scope
|
||||
(define register-in-scope :effects [mutation]
|
||||
(fn ((disposable :as lambda))
|
||||
(when *island-scope*
|
||||
(*island-scope* disposable))))
|
||||
@@ -322,7 +322,7 @@
|
||||
;; (dom-set-data el key val) → void — store JS value on element
|
||||
;; (dom-get-data el key) → any — retrieve stored value
|
||||
|
||||
(define with-marsh-scope
|
||||
(define with-marsh-scope :effects [mutation io]
|
||||
(fn (marsh-el (body-fn :as lambda))
|
||||
;; Execute body-fn collecting all disposables into a marsh-local list.
|
||||
;; Nested under the current island scope — if the island is disposed,
|
||||
@@ -335,7 +335,7 @@
|
||||
;; Store disposers on the marsh element for later cleanup
|
||||
(dom-set-data marsh-el "sx-marsh-disposers" disposers))))
|
||||
|
||||
(define dispose-marsh-scope
|
||||
(define dispose-marsh-scope :effects [mutation io]
|
||||
(fn (marsh-el)
|
||||
;; Dispose all effects/computeds registered in this marsh's scope.
|
||||
;; Parent island scope and sibling marshes are unaffected.
|
||||
@@ -358,7 +358,7 @@
|
||||
|
||||
(define *store-registry* (dict))
|
||||
|
||||
(define def-store
|
||||
(define def-store :effects [mutation]
|
||||
(fn ((name :as string) (init-fn :as lambda))
|
||||
(let ((registry *store-registry*))
|
||||
;; Only create the store once — subsequent calls return existing
|
||||
@@ -366,14 +366,14 @@
|
||||
(set! *store-registry* (assoc registry name (invoke init-fn))))
|
||||
(get *store-registry* name))))
|
||||
|
||||
(define use-store
|
||||
(define use-store :effects []
|
||||
(fn ((name :as string))
|
||||
(if (has-key? *store-registry* name)
|
||||
(get *store-registry* name)
|
||||
(error (str "Store not found: " name
|
||||
". Call (def-store ...) before (use-store ...).")))))
|
||||
|
||||
(define clear-stores
|
||||
(define clear-stores :effects [mutation]
|
||||
(fn ()
|
||||
(set! *store-registry* (dict))))
|
||||
|
||||
@@ -401,11 +401,11 @@
|
||||
;;
|
||||
;; These are platform primitives because they require browser DOM APIs.
|
||||
|
||||
(define emit-event
|
||||
(define emit-event :effects [io]
|
||||
(fn (el (event-name :as string) detail)
|
||||
(dom-dispatch el event-name detail)))
|
||||
|
||||
(define on-event
|
||||
(define on-event :effects [io]
|
||||
(fn (el (event-name :as string) (handler :as lambda))
|
||||
(dom-listen el event-name handler)))
|
||||
|
||||
@@ -415,7 +415,7 @@
|
||||
;; When the effect is disposed (island teardown), the listener is
|
||||
;; removed automatically via the cleanup return.
|
||||
|
||||
(define bridge-event
|
||||
(define bridge-event :effects [mutation io]
|
||||
(fn (el (event-name :as string) (target-signal :as signal) transform-fn)
|
||||
(effect (fn ()
|
||||
(let ((remove (dom-listen el event-name
|
||||
@@ -449,7 +449,7 @@
|
||||
;; Platform interface required:
|
||||
;; (promise-then promise on-resolve on-reject) → void
|
||||
|
||||
(define resource
|
||||
(define resource :effects [mutation io]
|
||||
(fn ((fetch-fn :as lambda))
|
||||
(let ((state (signal (dict "loading" true "data" nil "error" nil))))
|
||||
;; Kick off the async operation
|
||||
|
||||
@@ -209,6 +209,29 @@
|
||||
:example "(defmacro unless (condition &rest body)
|
||||
`(when (not ~condition) ~@body))")
|
||||
|
||||
(define-special-form "deftype"
|
||||
:syntax (deftype name body)
|
||||
:doc "Define a named type. The name can be a simple symbol for type aliases
|
||||
and records, or a list (name param ...) for parameterized types.
|
||||
Body is a type expression: a symbol (alias), (union t1 t2 ...) for
|
||||
union types, or {:field1 type1 :field2 type2} for record types.
|
||||
Type definitions are metadata for the type checker with no runtime cost."
|
||||
:tail-position "none"
|
||||
:example "(deftype price number)
|
||||
(deftype card-props {:title string :price number})
|
||||
(deftype (maybe a) (union a nil))")
|
||||
|
||||
(define-special-form "defeffect"
|
||||
:syntax (defeffect name)
|
||||
:doc "Declare a named effect. Effects annotate functions and components
|
||||
to track side effects. A pure function (:effects [pure]) cannot
|
||||
call IO functions. Unannotated functions are assumed to have all
|
||||
effects. Effect checking is gradual — annotations opt in."
|
||||
:tail-position "none"
|
||||
:example "(defeffect io)
|
||||
(defeffect async)
|
||||
(define add :effects [pure] (fn (a b) (+ a b)))")
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Sequencing and threading
|
||||
|
||||
@@ -181,8 +181,15 @@ def make_macro(params, rest_param, body, env, name=None):
|
||||
closure=dict(env), name=name)
|
||||
|
||||
|
||||
def make_handler_def(name, params, body, env):
|
||||
return HandlerDef(name=name, params=list(params), body=body, closure=dict(env))
|
||||
def make_handler_def(name, params, body, env, opts=None):
|
||||
path = opts.get('path') if opts else None
|
||||
method = str(opts.get('method', 'get')) if opts else 'get'
|
||||
csrf = opts.get('csrf', True) if opts else True
|
||||
returns = str(opts.get('returns', 'element')) if opts else 'element'
|
||||
if isinstance(csrf, str):
|
||||
csrf = csrf.lower() not in ('false', 'nil', 'no')
|
||||
return HandlerDef(name=name, params=list(params), body=body, closure=dict(env),
|
||||
path=path, method=method.lower(), csrf=csrf, returns=returns)
|
||||
|
||||
|
||||
def make_query_def(name, params, doc, body, env):
|
||||
@@ -534,6 +541,11 @@ def strip_prefix(s, prefix):
|
||||
return s[len(prefix):] if s.startswith(prefix) else s
|
||||
|
||||
|
||||
def debug_log(*args):
|
||||
import sys
|
||||
print(*args, file=sys.stderr)
|
||||
|
||||
|
||||
def error(msg):
|
||||
raise EvalError(msg)
|
||||
|
||||
@@ -1255,6 +1267,10 @@ def eval_list(expr, env):
|
||||
return sf_defquery(args, env)
|
||||
elif sx_truthy((name == 'defaction')):
|
||||
return sf_defaction(args, env)
|
||||
elif sx_truthy((name == 'deftype')):
|
||||
return sf_deftype(args, env)
|
||||
elif sx_truthy((name == 'defeffect')):
|
||||
return sf_defeffect(args, env)
|
||||
elif sx_truthy((name == 'begin')):
|
||||
return sf_begin(args, env)
|
||||
elif sx_truthy((name == 'do')):
|
||||
@@ -1504,10 +1520,18 @@ def sf_lambda(args, env):
|
||||
# sf-define
|
||||
def sf_define(args, env):
|
||||
name_sym = first(args)
|
||||
value = trampoline(eval_expr(nth(args, 1), env))
|
||||
has_effects = ((len(args) >= 4) if not sx_truthy((len(args) >= 4)) else ((type_of(nth(args, 1)) == 'keyword') if not sx_truthy((type_of(nth(args, 1)) == 'keyword')) else (keyword_name(nth(args, 1)) == 'effects')))
|
||||
val_idx = (3 if sx_truthy(((len(args) >= 4) if not sx_truthy((len(args) >= 4)) else ((type_of(nth(args, 1)) == 'keyword') if not sx_truthy((type_of(nth(args, 1)) == 'keyword')) else (keyword_name(nth(args, 1)) == 'effects')))) else 1)
|
||||
value = trampoline(eval_expr(nth(args, val_idx), env))
|
||||
if sx_truthy((is_lambda(value) if not sx_truthy(is_lambda(value)) else is_nil(lambda_name(value)))):
|
||||
value.name = symbol_name(name_sym)
|
||||
env[symbol_name(name_sym)] = value
|
||||
if sx_truthy(has_effects):
|
||||
effects_raw = nth(args, 2)
|
||||
effect_list = (map(lambda e: (symbol_name(e) if sx_truthy((type_of(e) == 'symbol')) else sx_str(e)), effects_raw) if sx_truthy((type_of(effects_raw) == 'list')) else [sx_str(effects_raw)])
|
||||
effect_anns = (env_get(env, '*effect-annotations*') if sx_truthy(env_has(env, '*effect-annotations*')) else {})
|
||||
effect_anns[symbol_name(name_sym)] = effect_list
|
||||
env['*effect-annotations*'] = effect_anns
|
||||
return value
|
||||
|
||||
# sf-defcomp
|
||||
@@ -1522,8 +1546,14 @@ def sf_defcomp(args, env):
|
||||
param_types = nth(parsed, 2)
|
||||
affinity = defcomp_kwarg(args, 'affinity', 'auto')
|
||||
comp = make_component(comp_name, params, has_children, body, env, affinity)
|
||||
effects = defcomp_kwarg(args, 'effects', NIL)
|
||||
if sx_truthy(((not sx_truthy(is_nil(param_types))) if not sx_truthy((not sx_truthy(is_nil(param_types)))) else (not sx_truthy(empty_p(keys(param_types)))))):
|
||||
component_set_param_types(comp, param_types)
|
||||
if sx_truthy((not sx_truthy(is_nil(effects)))):
|
||||
effect_list = (map(lambda e: (symbol_name(e) if sx_truthy((type_of(e) == 'symbol')) else sx_str(e)), effects) if sx_truthy((type_of(effects) == 'list')) else [sx_str(effects)])
|
||||
effect_anns = (env_get(env, '*effect-annotations*') if sx_truthy(env_has(env, '*effect-annotations*')) else {})
|
||||
effect_anns[symbol_name(name_sym)] = effect_list
|
||||
env['*effect-annotations*'] = effect_anns
|
||||
env[symbol_name(name_sym)] = comp
|
||||
return comp
|
||||
|
||||
@@ -1610,6 +1640,62 @@ def sf_defstyle(args, env):
|
||||
env[symbol_name(name_sym)] = value
|
||||
return value
|
||||
|
||||
# make-type-def
|
||||
def make_type_def(name, params, body):
|
||||
return {'name': name, 'params': params, 'body': body}
|
||||
|
||||
# normalize-type-body
|
||||
def normalize_type_body(body):
|
||||
if sx_truthy(is_nil(body)):
|
||||
return 'nil'
|
||||
elif sx_truthy((type_of(body) == 'symbol')):
|
||||
return symbol_name(body)
|
||||
elif sx_truthy((type_of(body) == 'string')):
|
||||
return body
|
||||
elif sx_truthy((type_of(body) == 'keyword')):
|
||||
return keyword_name(body)
|
||||
elif sx_truthy((type_of(body) == 'dict')):
|
||||
return map_dict(lambda k, v: normalize_type_body(v), body)
|
||||
elif sx_truthy((type_of(body) == 'list')):
|
||||
if sx_truthy(empty_p(body)):
|
||||
return 'any'
|
||||
else:
|
||||
head = first(body)
|
||||
head_name = (symbol_name(head) if sx_truthy((type_of(head) == 'symbol')) else sx_str(head))
|
||||
if sx_truthy((head_name == 'union')):
|
||||
return cons('or', map(normalize_type_body, rest(body)))
|
||||
else:
|
||||
return cons(head_name, map(normalize_type_body, rest(body)))
|
||||
else:
|
||||
return sx_str(body)
|
||||
|
||||
# sf-deftype
|
||||
def sf_deftype(args, env):
|
||||
name_or_form = first(args)
|
||||
body_expr = nth(args, 1)
|
||||
type_name = NIL
|
||||
type_params = []
|
||||
if sx_truthy((type_of(name_or_form) == 'symbol')):
|
||||
type_name = symbol_name(name_or_form)
|
||||
else:
|
||||
if sx_truthy((type_of(name_or_form) == 'list')):
|
||||
type_name = symbol_name(first(name_or_form))
|
||||
type_params = map(lambda p: (symbol_name(p) if sx_truthy((type_of(p) == 'symbol')) else sx_str(p)), rest(name_or_form))
|
||||
body = normalize_type_body(body_expr)
|
||||
registry = (env_get(env, '*type-registry*') if sx_truthy(env_has(env, '*type-registry*')) else {})
|
||||
registry[type_name] = make_type_def(type_name, type_params, body)
|
||||
env['*type-registry*'] = registry
|
||||
return NIL
|
||||
|
||||
# sf-defeffect
|
||||
def sf_defeffect(args, env):
|
||||
effect_name = (symbol_name(first(args)) if sx_truthy((type_of(first(args)) == 'symbol')) else sx_str(first(args)))
|
||||
registry = (env_get(env, '*effect-registry*') if sx_truthy(env_has(env, '*effect-registry*')) else [])
|
||||
if sx_truthy((not sx_truthy(contains_p(registry, effect_name)))):
|
||||
registry.append(effect_name)
|
||||
env['*effect-registry*'] = registry
|
||||
return NIL
|
||||
|
||||
# sf-begin
|
||||
def sf_begin(args, env):
|
||||
if sx_truthy(empty_p(args)):
|
||||
@@ -1776,14 +1862,43 @@ def parse_key_params(params_expr):
|
||||
params.append(name)
|
||||
return params
|
||||
|
||||
# parse-handler-args
|
||||
def parse_handler_args(args):
|
||||
_cells = {}
|
||||
'Parse defhandler args after the name symbol.\n Scans for :keyword value option pairs, then a list (params), then body.\n Returns dict with keys: opts, params, body.'
|
||||
opts = {}
|
||||
_cells['params'] = []
|
||||
_cells['body'] = NIL
|
||||
_cells['i'] = 0
|
||||
n = len(args)
|
||||
_cells['done'] = False
|
||||
for idx in range(0, n):
|
||||
if sx_truthy(((not sx_truthy(_cells['done'])) if not sx_truthy((not sx_truthy(_cells['done']))) else (idx == _cells['i']))):
|
||||
arg = nth(args, idx)
|
||||
if sx_truthy((type_of(arg) == 'keyword')):
|
||||
if sx_truthy(((idx + 1) < n)):
|
||||
val = nth(args, (idx + 1))
|
||||
opts[keyword_name(arg)] = (keyword_name(val) if sx_truthy((type_of(val) == 'keyword')) else val)
|
||||
_cells['i'] = (idx + 2)
|
||||
elif sx_truthy((type_of(arg) == 'list')):
|
||||
_cells['params'] = parse_key_params(arg)
|
||||
if sx_truthy(((idx + 1) < n)):
|
||||
_cells['body'] = nth(args, (idx + 1))
|
||||
_cells['done'] = True
|
||||
else:
|
||||
_cells['body'] = arg
|
||||
_cells['done'] = True
|
||||
return {'opts': opts, 'params': _cells['params'], 'body': _cells['body']}
|
||||
|
||||
# sf-defhandler
|
||||
def sf_defhandler(args, env):
|
||||
name_sym = first(args)
|
||||
params_raw = nth(args, 1)
|
||||
body = nth(args, 2)
|
||||
name = symbol_name(name_sym)
|
||||
params = parse_key_params(params_raw)
|
||||
hdef = make_handler_def(name, params, body, env)
|
||||
parsed = parse_handler_args(rest(args))
|
||||
opts = get(parsed, 'opts')
|
||||
params = get(parsed, 'params')
|
||||
body = get(parsed, 'body')
|
||||
hdef = make_handler_def(name, params, body, env, opts)
|
||||
env[sx_str('handler:', name)] = hdef
|
||||
return hdef
|
||||
|
||||
@@ -1869,7 +1984,7 @@ BOOLEAN_ATTRS = ['async', 'autofocus', 'autoplay', 'checked', 'controls', 'defau
|
||||
|
||||
# definition-form?
|
||||
def is_definition_form(name):
|
||||
return ((name == 'define') if sx_truthy((name == 'define')) else ((name == 'defcomp') if sx_truthy((name == 'defcomp')) else ((name == 'defisland') if sx_truthy((name == 'defisland')) else ((name == 'defmacro') if sx_truthy((name == 'defmacro')) else ((name == 'defstyle') if sx_truthy((name == 'defstyle')) else (name == 'defhandler'))))))
|
||||
return ((name == 'define') if sx_truthy((name == 'define')) else ((name == 'defcomp') if sx_truthy((name == 'defcomp')) else ((name == 'defisland') if sx_truthy((name == 'defisland')) else ((name == 'defmacro') if sx_truthy((name == 'defmacro')) else ((name == 'defstyle') if sx_truthy((name == 'defstyle')) else ((name == 'defhandler') if sx_truthy((name == 'defhandler')) else ((name == 'deftype') if sx_truthy((name == 'deftype')) else (name == 'defeffect'))))))))
|
||||
|
||||
# parse-element-args
|
||||
def parse_element_args(args, env):
|
||||
@@ -1995,7 +2110,7 @@ def render_value_to_html(val, env):
|
||||
return escape_html(sx_str(val))
|
||||
|
||||
# RENDER_HTML_FORMS
|
||||
RENDER_HTML_FORMS = ['if', 'when', 'cond', 'case', 'let', 'let*', 'begin', 'do', 'define', 'defcomp', 'defisland', 'defmacro', 'defstyle', 'defhandler', 'map', 'map-indexed', 'filter', 'for-each']
|
||||
RENDER_HTML_FORMS = ['if', 'when', 'cond', 'case', 'let', 'let*', 'begin', 'do', 'define', 'defcomp', 'defisland', 'defmacro', 'defstyle', 'defhandler', 'deftype', 'defeffect', 'map', 'map-indexed', 'filter', 'for-each']
|
||||
|
||||
# render-html-form?
|
||||
def is_render_html_form(name):
|
||||
@@ -2285,7 +2400,7 @@ def aser_call(name, args, env):
|
||||
return sx_str('(', join(' ', parts), ')')
|
||||
|
||||
# SPECIAL_FORM_NAMES
|
||||
SPECIAL_FORM_NAMES = ['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']
|
||||
SPECIAL_FORM_NAMES = ['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', 'deftype', 'defeffect']
|
||||
|
||||
# HO_FORM_NAMES
|
||||
HO_FORM_NAMES = ['map', 'map-indexed', 'filter', 'reduce', 'some', 'every?', 'for-each']
|
||||
@@ -2379,7 +2494,7 @@ def aser_special(name, expr, env):
|
||||
elif sx_truthy((name == 'defisland')):
|
||||
trampoline(eval_expr(expr, env))
|
||||
return serialize(expr)
|
||||
elif sx_truthy(((name == 'define') if sx_truthy((name == 'define')) else ((name == 'defcomp') if sx_truthy((name == 'defcomp')) else ((name == 'defmacro') if sx_truthy((name == 'defmacro')) else ((name == 'defstyle') if sx_truthy((name == 'defstyle')) else ((name == 'defhandler') if sx_truthy((name == 'defhandler')) else ((name == 'defpage') if sx_truthy((name == 'defpage')) else ((name == 'defquery') if sx_truthy((name == 'defquery')) else ((name == 'defaction') if sx_truthy((name == 'defaction')) else (name == 'defrelation')))))))))):
|
||||
elif sx_truthy(((name == 'define') if sx_truthy((name == 'define')) else ((name == 'defcomp') if sx_truthy((name == 'defcomp')) else ((name == 'defmacro') if sx_truthy((name == 'defmacro')) else ((name == 'defstyle') if sx_truthy((name == 'defstyle')) else ((name == 'defhandler') if sx_truthy((name == 'defhandler')) else ((name == 'defpage') if sx_truthy((name == 'defpage')) else ((name == 'defquery') if sx_truthy((name == 'defquery')) else ((name == 'defaction') if sx_truthy((name == 'defaction')) else ((name == 'defrelation') if sx_truthy((name == 'defrelation')) else ((name == 'deftype') if sx_truthy((name == 'deftype')) else (name == 'defeffect')))))))))))):
|
||||
trampoline(eval_expr(expr, env))
|
||||
return NIL
|
||||
else:
|
||||
@@ -3143,7 +3258,7 @@ async def async_map_render(exprs, env, ctx):
|
||||
return results
|
||||
|
||||
# ASYNC_RENDER_FORMS
|
||||
ASYNC_RENDER_FORMS = ['if', 'when', 'cond', 'case', 'let', 'let*', 'begin', 'do', 'define', 'defcomp', 'defisland', 'defmacro', 'defstyle', 'defhandler', 'map', 'map-indexed', 'filter', 'for-each']
|
||||
ASYNC_RENDER_FORMS = ['if', 'when', 'cond', 'case', 'let', 'let*', 'begin', 'do', 'define', 'defcomp', 'defisland', 'defmacro', 'defstyle', 'defhandler', 'deftype', 'defeffect', 'map', 'map-indexed', 'filter', 'for-each']
|
||||
|
||||
# async-render-form?
|
||||
def async_render_form_p(name):
|
||||
@@ -3518,7 +3633,7 @@ async def async_aser_call(name, args, env, ctx):
|
||||
return make_sx_expr(sx_str('(', join(' ', parts), ')'))
|
||||
|
||||
# ASYNC_ASER_FORM_NAMES
|
||||
ASYNC_ASER_FORM_NAMES = ['if', 'when', 'cond', 'case', 'and', 'or', 'let', 'let*', 'lambda', 'fn', 'define', 'defcomp', 'defmacro', 'defstyle', 'defhandler', 'defpage', 'defquery', 'defaction', 'begin', 'do', 'quote', '->', 'set!', 'defisland']
|
||||
ASYNC_ASER_FORM_NAMES = ['if', 'when', 'cond', 'case', 'and', 'or', 'let', 'let*', 'lambda', 'fn', 'define', 'defcomp', 'defmacro', 'defstyle', 'defhandler', 'defpage', 'defquery', 'defaction', 'begin', 'do', 'quote', '->', 'set!', 'defisland', 'deftype', 'defeffect']
|
||||
|
||||
# ASYNC_ASER_HO_NAMES
|
||||
ASYNC_ASER_HO_NAMES = ['map', 'map-indexed', 'filter', 'for-each']
|
||||
@@ -3609,7 +3724,7 @@ async def dispatch_async_aser_form(name, expr, env, ctx):
|
||||
elif sx_truthy((name == 'defisland')):
|
||||
(await async_eval(expr, env, ctx))
|
||||
return serialize(expr)
|
||||
elif sx_truthy(((name == 'define') if sx_truthy((name == 'define')) else ((name == 'defcomp') if sx_truthy((name == 'defcomp')) else ((name == 'defmacro') if sx_truthy((name == 'defmacro')) else ((name == 'defstyle') if sx_truthy((name == 'defstyle')) else ((name == 'defhandler') if sx_truthy((name == 'defhandler')) else ((name == 'defpage') if sx_truthy((name == 'defpage')) else ((name == 'defquery') if sx_truthy((name == 'defquery')) else (name == 'defaction'))))))))):
|
||||
elif sx_truthy(((name == 'define') if sx_truthy((name == 'define')) else ((name == 'defcomp') if sx_truthy((name == 'defcomp')) else ((name == 'defmacro') if sx_truthy((name == 'defmacro')) else ((name == 'defstyle') if sx_truthy((name == 'defstyle')) else ((name == 'defhandler') if sx_truthy((name == 'defhandler')) else ((name == 'defpage') if sx_truthy((name == 'defpage')) else ((name == 'defquery') if sx_truthy((name == 'defquery')) else ((name == 'defaction') if sx_truthy((name == 'defaction')) else ((name == 'deftype') if sx_truthy((name == 'deftype')) else (name == 'defeffect'))))))))))):
|
||||
(await async_eval(expr, env, ctx))
|
||||
return NIL
|
||||
else:
|
||||
|
||||
@@ -427,6 +427,173 @@
|
||||
(body (first (sx-parse "(div (+ name 1))")))
|
||||
(type-env {"name" "string"})
|
||||
(diagnostics (list)))
|
||||
(check-body-walk body "~bad-math" type-env (test-prim-types) ppt (test-env) diagnostics)
|
||||
(check-body-walk body "~bad-math" type-env (test-prim-types) ppt (test-env) diagnostics nil nil)
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — type aliases
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-alias"
|
||||
(deftest "simple alias resolves"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}}))
|
||||
(assert-equal "number" (resolve-type "price" registry))))
|
||||
|
||||
(deftest "alias chain resolves"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}
|
||||
"cost" {:name "cost" :params () :body "price"}}))
|
||||
(assert-equal "number" (resolve-type "cost" registry))))
|
||||
|
||||
(deftest "unknown type passes through"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}}))
|
||||
(assert-equal "string" (resolve-type "string" registry))))
|
||||
|
||||
(deftest "subtype-resolved? works through alias"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}}))
|
||||
(assert-true (subtype-resolved? "price" "number" registry))
|
||||
(assert-true (subtype-resolved? "number" "price" registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — union types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-union"
|
||||
(deftest "union resolves"
|
||||
(let ((registry {"status" {:name "status" :params () :body ("or" "string" "number")}}))
|
||||
(let ((resolved (resolve-type "status" registry)))
|
||||
(assert-true (= (type-of resolved) "list"))
|
||||
(assert-equal "or" (first resolved)))))
|
||||
|
||||
(deftest "subtype through named union"
|
||||
(let ((registry {"status" {:name "status" :params () :body ("or" "string" "number")}}))
|
||||
(assert-true (subtype-resolved? "string" "status" registry))
|
||||
(assert-true (subtype-resolved? "number" "status" registry))
|
||||
(assert-false (subtype-resolved? "boolean" "status" registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — record types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-record"
|
||||
(deftest "record resolves to dict"
|
||||
(let ((registry {"card-props" {:name "card-props" :params ()
|
||||
:body {"title" "string" "price" "number"}}}))
|
||||
(let ((resolved (resolve-type "card-props" registry)))
|
||||
(assert-equal "dict" (type-of resolved))
|
||||
(assert-equal "string" (get resolved "title"))
|
||||
(assert-equal "number" (get resolved "price")))))
|
||||
|
||||
(deftest "record structural subtyping"
|
||||
(let ((registry {"card-props" {:name "card-props" :params ()
|
||||
:body {"title" "string" "price" "number"}}
|
||||
"titled" {:name "titled" :params ()
|
||||
:body {"title" "string"}}}))
|
||||
;; card-props has title+price, titled has just title
|
||||
;; card-props <: titled (has all required fields)
|
||||
(assert-true (subtype-resolved? "card-props" "titled" registry))))
|
||||
|
||||
(deftest "get infers field type from record"
|
||||
(let ((registry {"card-props" {:name "card-props" :params ()
|
||||
:body {"title" "string" "price" "number"}}})
|
||||
(type-env {"d" "card-props"})
|
||||
(expr (first (sx-parse "(get d :title)"))))
|
||||
(assert-equal "string"
|
||||
(infer-type expr type-env (test-prim-types) registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — parameterized types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-parameterized"
|
||||
(deftest "maybe instantiation"
|
||||
(let ((registry {"maybe" {:name "maybe" :params ("a")
|
||||
:body ("or" "a" "nil")}}))
|
||||
(let ((resolved (resolve-type (list "maybe" "string") registry)))
|
||||
(assert-true (= (type-of resolved) "list"))
|
||||
(assert-equal "or" (first resolved))
|
||||
(assert-true (contains? resolved "string"))
|
||||
(assert-true (contains? resolved "nil")))))
|
||||
|
||||
(deftest "subtype through parameterized type"
|
||||
(let ((registry {"maybe" {:name "maybe" :params ("a")
|
||||
:body ("or" "a" "nil")}}))
|
||||
(assert-true (subtype-resolved? "string" (list "maybe" "string") registry))
|
||||
(assert-true (subtype-resolved? "nil" (list "maybe" "string") registry))
|
||||
(assert-false (subtype-resolved? "number" (list "maybe" "string") registry))))
|
||||
|
||||
(deftest "substitute-type-vars works"
|
||||
(let ((result (substitute-type-vars ("or" "a" "nil") (list "a") (list "number"))))
|
||||
(assert-equal "or" (first result))
|
||||
(assert-true (contains? result "number"))
|
||||
(assert-true (contains? result "nil")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defeffect — effect basics
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "defeffect-basics"
|
||||
(deftest "get-effects returns nil for unannotated"
|
||||
(let ((anns {"fetch" ("io")}))
|
||||
(assert-true (nil? (get-effects "unknown" anns)))))
|
||||
|
||||
(deftest "get-effects returns effects for annotated"
|
||||
(let ((anns {"fetch" ("io")}))
|
||||
(assert-equal (list "io") (get-effects "fetch" anns))))
|
||||
|
||||
(deftest "nil annotations returns nil"
|
||||
(assert-true (nil? (get-effects "anything" nil)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defeffect — effect checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "effect-checking"
|
||||
(deftest "pure cannot call io"
|
||||
(let ((anns {"~pure-comp" () "fetch" ("io")}))
|
||||
(let ((diagnostics (check-effect-call "fetch" (list) anns "~pure-comp")))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "io context allows io"
|
||||
(let ((anns {"~io-comp" ("io") "fetch" ("io")}))
|
||||
(let ((diagnostics (check-effect-call "fetch" (list "io") anns "~io-comp")))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "unannotated caller allows everything"
|
||||
(let ((anns {"fetch" ("io")}))
|
||||
(let ((diagnostics (check-effect-call "fetch" nil anns "~unknown")))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "unannotated callee skips check"
|
||||
(let ((anns {"~pure-comp" ()}))
|
||||
(let ((diagnostics (check-effect-call "unknown-fn" (list) anns "~pure-comp")))
|
||||
(assert-equal 0 (len diagnostics))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defeffect — subset checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "effect-subset"
|
||||
(deftest "empty is subset of anything"
|
||||
(assert-true (effects-subset? (list) (list "io")))
|
||||
(assert-true (effects-subset? (list) (list))))
|
||||
|
||||
(deftest "io is subset of io"
|
||||
(assert-true (effects-subset? (list "io") (list "io" "async"))))
|
||||
|
||||
(deftest "io is not subset of pure"
|
||||
(assert-false (effects-subset? (list "io") (list))))
|
||||
|
||||
(deftest "nil callee skips check"
|
||||
(assert-true (effects-subset? nil (list))))
|
||||
|
||||
(deftest "nil caller allows all"
|
||||
(assert-true (effects-subset? (list "io") nil))))
|
||||
|
||||
@@ -224,7 +224,7 @@
|
||||
;; type-env is a dict mapping variable names → types.
|
||||
|
||||
(define infer-type
|
||||
(fn (node (type-env :as dict) (prim-types :as dict))
|
||||
(fn (node (type-env :as dict) (prim-types :as dict) type-registry)
|
||||
(let ((kind (type-of node)))
|
||||
(if (= kind "number") "number"
|
||||
(if (= kind "string") "string"
|
||||
@@ -234,24 +234,24 @@
|
||||
(if (= kind "symbol")
|
||||
(let ((name (symbol-name node)))
|
||||
;; Look up in type env
|
||||
(if (dict-has? type-env name)
|
||||
(dict-get type-env name)
|
||||
(if (has-key? type-env name)
|
||||
(get type-env name)
|
||||
;; Builtins
|
||||
(if (= name "true") "boolean"
|
||||
(if (= name "false") "boolean"
|
||||
(if (= name "nil") "nil"
|
||||
;; Check primitive return types
|
||||
(if (dict-has? prim-types name)
|
||||
(dict-get prim-types name)
|
||||
(if (has-key? prim-types name)
|
||||
(get prim-types name)
|
||||
"any"))))))
|
||||
(if (= kind "dict") "dict"
|
||||
(if (= kind "list")
|
||||
(infer-list-type node type-env prim-types)
|
||||
(infer-list-type node type-env prim-types type-registry)
|
||||
"any")))))))))))
|
||||
|
||||
|
||||
(define infer-list-type
|
||||
(fn (node (type-env :as dict) (prim-types :as dict))
|
||||
(fn (node (type-env :as dict) (prim-types :as dict) type-registry)
|
||||
;; Infer type of a list expression (function call, special form, etc.)
|
||||
(if (empty? node) "list"
|
||||
(let ((head (first node))
|
||||
@@ -261,32 +261,32 @@
|
||||
(let ((name (symbol-name head)))
|
||||
;; Special forms
|
||||
(if (= name "if")
|
||||
(infer-if-type args type-env prim-types)
|
||||
(infer-if-type args type-env prim-types type-registry)
|
||||
(if (= name "when")
|
||||
(if (>= (len args) 2)
|
||||
(type-union (infer-type (last args) type-env prim-types) "nil")
|
||||
(type-union (infer-type (last args) type-env prim-types type-registry) "nil")
|
||||
"nil")
|
||||
(if (or (= name "cond") (= name "case"))
|
||||
"any" ;; complex — could be refined later
|
||||
(if (= name "let")
|
||||
(infer-let-type args type-env prim-types)
|
||||
(infer-let-type args type-env prim-types type-registry)
|
||||
(if (or (= name "do") (= name "begin"))
|
||||
(if (empty? args) "nil"
|
||||
(infer-type (last args) type-env prim-types))
|
||||
(infer-type (last args) type-env prim-types type-registry))
|
||||
(if (or (= name "lambda") (= name "fn"))
|
||||
"lambda"
|
||||
(if (= name "and")
|
||||
(if (empty? args) "boolean"
|
||||
(infer-type (last args) type-env prim-types))
|
||||
(infer-type (last args) type-env prim-types type-registry))
|
||||
(if (= name "or")
|
||||
(if (empty? args) "boolean"
|
||||
;; or returns first truthy — union of all args
|
||||
(reduce type-union "never"
|
||||
(map (fn (a) (infer-type a type-env prim-types)) args)))
|
||||
(map (fn (a) (infer-type a type-env prim-types type-registry)) args)))
|
||||
(if (= name "map")
|
||||
;; map returns a list
|
||||
(if (>= (len args) 2)
|
||||
(let ((fn-type (infer-type (first args) type-env prim-types)))
|
||||
(let ((fn-type (infer-type (first args) type-env prim-types type-registry)))
|
||||
;; If the fn's return type is known, produce (list-of return-type)
|
||||
(if (and (= (type-of fn-type) "list")
|
||||
(= (first fn-type) "->"))
|
||||
@@ -296,7 +296,7 @@
|
||||
(if (= name "filter")
|
||||
;; filter preserves element type
|
||||
(if (>= (len args) 2)
|
||||
(infer-type (nth args 1) type-env prim-types)
|
||||
(infer-type (nth args 1) type-env prim-types type-registry)
|
||||
"list")
|
||||
(if (= name "reduce")
|
||||
;; reduce returns the accumulator type — too complex to infer
|
||||
@@ -311,26 +311,45 @@
|
||||
"string"
|
||||
(if (= name "not")
|
||||
"boolean"
|
||||
(if (= name "get")
|
||||
;; get — resolve record field type from type registry
|
||||
(if (and (>= (len args) 2) (not (nil? type-registry)))
|
||||
(let ((dict-type (infer-type (first args) type-env prim-types type-registry))
|
||||
(key-arg (nth args 1))
|
||||
(key-name (cond
|
||||
(= (type-of key-arg) "keyword") (keyword-name key-arg)
|
||||
(= (type-of key-arg) "string") key-arg
|
||||
:else nil)))
|
||||
(if (and key-name
|
||||
(= (type-of dict-type) "string")
|
||||
(has-key? type-registry dict-type))
|
||||
(let ((resolved (resolve-type dict-type type-registry)))
|
||||
(if (and (= (type-of resolved) "dict")
|
||||
(has-key? resolved key-name))
|
||||
(get resolved key-name)
|
||||
"any"))
|
||||
"any"))
|
||||
"any")
|
||||
(if (starts-with? name "~")
|
||||
"element" ;; component call
|
||||
;; Regular function call: look up return type
|
||||
(if (dict-has? prim-types name)
|
||||
(dict-get prim-types name)
|
||||
"any"))))))))))))))))))))))))
|
||||
(if (has-key? prim-types name)
|
||||
(get prim-types name)
|
||||
"any")))))))))))))))))))))))))
|
||||
|
||||
|
||||
(define infer-if-type
|
||||
(fn ((args :as list) (type-env :as dict) (prim-types :as dict))
|
||||
(fn ((args :as list) (type-env :as dict) (prim-types :as dict) type-registry)
|
||||
;; (if test then else?) → union of then and else types
|
||||
(if (< (len args) 2) "nil"
|
||||
(let ((then-type (infer-type (nth args 1) type-env prim-types)))
|
||||
(let ((then-type (infer-type (nth args 1) type-env prim-types type-registry)))
|
||||
(if (>= (len args) 3)
|
||||
(type-union then-type (infer-type (nth args 2) type-env prim-types))
|
||||
(type-union then-type (infer-type (nth args 2) type-env prim-types type-registry))
|
||||
(type-union then-type "nil"))))))
|
||||
|
||||
|
||||
(define infer-let-type
|
||||
(fn ((args :as list) (type-env :as dict) (prim-types :as dict))
|
||||
(fn ((args :as list) (type-env :as dict) (prim-types :as dict) type-registry)
|
||||
;; (let ((x expr) ...) body) → type of body in extended type-env
|
||||
(if (< (len args) 2) "nil"
|
||||
(let ((bindings (first args))
|
||||
@@ -343,10 +362,10 @@
|
||||
(let ((name (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(str (first binding))))
|
||||
(val-type (infer-type (nth binding 1) extended prim-types)))
|
||||
(val-type (infer-type (nth binding 1) extended prim-types type-registry)))
|
||||
(dict-set! extended name val-type))))
|
||||
bindings)
|
||||
(infer-type body extended prim-types)))))
|
||||
(infer-type body extended prim-types type-registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -371,14 +390,14 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-primitive-call
|
||||
(fn ((name :as string) (args :as list) (type-env :as dict) (prim-types :as dict) prim-param-types (comp-name :as string))
|
||||
(fn ((name :as string) (args :as list) (type-env :as dict) (prim-types :as dict) prim-param-types (comp-name :as string) type-registry)
|
||||
;; Check a primitive call site against declared param types.
|
||||
;; prim-param-types is a dict: {prim-name → {:positional [...] :rest-type type-or-nil}}
|
||||
;; Each positional entry is a list (name type-or-nil).
|
||||
;; Returns list of diagnostics.
|
||||
(let ((diagnostics (list)))
|
||||
(when (and (not (nil? prim-param-types))
|
||||
(dict-has? prim-param-types name))
|
||||
(has-key? prim-param-types name))
|
||||
(let ((sig (get prim-param-types name))
|
||||
(positional (get sig "positional"))
|
||||
(rest-type (get sig "rest-type")))
|
||||
@@ -392,10 +411,10 @@
|
||||
(arg-expr (nth args idx)))
|
||||
(let ((expected-type (nth param-info 1)))
|
||||
(when (not (nil? expected-type))
|
||||
(let ((actual (infer-type arg-expr type-env prim-types)))
|
||||
(let ((actual (infer-type arg-expr type-env prim-types type-registry)))
|
||||
(when (and (not (type-any? expected-type))
|
||||
(not (type-any? actual))
|
||||
(not (subtype? actual expected-type)))
|
||||
(not (subtype-resolved? actual expected-type type-registry)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "Argument " (+ idx 1) " of `" name
|
||||
@@ -404,10 +423,10 @@
|
||||
;; Rest param — check against rest-type
|
||||
(when (not (nil? rest-type))
|
||||
(let ((arg-expr (nth args idx))
|
||||
(actual (infer-type arg-expr type-env prim-types)))
|
||||
(actual (infer-type arg-expr type-env prim-types type-registry)))
|
||||
(when (and (not (type-any? rest-type))
|
||||
(not (type-any? actual))
|
||||
(not (subtype? actual rest-type)))
|
||||
(not (subtype-resolved? actual rest-type type-registry)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "Argument " (+ idx 1) " of `" name
|
||||
@@ -418,7 +437,7 @@
|
||||
|
||||
|
||||
(define check-component-call
|
||||
(fn ((comp-name :as string) (comp :as component) (call-args :as list) (type-env :as dict) (prim-types :as dict))
|
||||
(fn ((comp-name :as string) (comp :as component) (call-args :as list) (type-env :as dict) (prim-types :as dict) type-registry)
|
||||
;; Check a component call site against its declared param types.
|
||||
;; comp is the component value, call-args is the list of args
|
||||
;; from the call site (after the component name).
|
||||
@@ -440,12 +459,12 @@
|
||||
(when (< (+ idx 1) (len call-args))
|
||||
(let ((val-expr (nth call-args (+ idx 1))))
|
||||
;; Check type of value against declared param type
|
||||
(when (dict-has? param-types key-name)
|
||||
(let ((expected (dict-get param-types key-name))
|
||||
(actual (infer-type val-expr type-env prim-types)))
|
||||
(when (has-key? param-types key-name)
|
||||
(let ((expected (get param-types key-name))
|
||||
(actual (infer-type val-expr type-env prim-types type-registry)))
|
||||
(when (and (not (type-any? expected))
|
||||
(not (type-any? actual))
|
||||
(not (subtype? actual expected)))
|
||||
(not (subtype-resolved? actual expected type-registry)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "Keyword :" key-name " of " comp-name
|
||||
@@ -456,9 +475,9 @@
|
||||
;; Check for missing required params (those with declared types)
|
||||
(for-each
|
||||
(fn (param-name)
|
||||
(when (and (dict-has? param-types param-name)
|
||||
(when (and (has-key? param-types param-name)
|
||||
(not (contains? provided-keys param-name))
|
||||
(not (type-nullable? (dict-get param-types param-name))))
|
||||
(not (type-nullable? (get param-types param-name))))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "warning"
|
||||
(str "Required param :" param-name " of " comp-name " not provided")
|
||||
@@ -482,9 +501,11 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-body-walk
|
||||
(fn (node (comp-name :as string) (type-env :as dict) (prim-types :as dict) prim-param-types env (diagnostics :as list))
|
||||
(fn (node (comp-name :as string) (type-env :as dict) (prim-types :as dict) prim-param-types env (diagnostics :as list) type-registry effect-annotations)
|
||||
;; Recursively walk an AST and collect diagnostics.
|
||||
;; prim-param-types: dict of {name → {:positional [...] :rest-type t}} or nil
|
||||
;; type-registry: dict of {type-name → type-def} or nil
|
||||
;; effect-annotations: dict of {fn-name → effect-list} or nil
|
||||
(let ((kind (type-of node)))
|
||||
(when (= kind "list")
|
||||
(when (not (empty? node))
|
||||
@@ -500,16 +521,30 @@
|
||||
(for-each
|
||||
(fn (d) (append! diagnostics d))
|
||||
(check-component-call name comp-val args
|
||||
type-env prim-types)))))
|
||||
type-env prim-types type-registry))))
|
||||
;; Effect check for component calls
|
||||
(when (not (nil? effect-annotations))
|
||||
(let ((caller-effects (get-effects comp-name effect-annotations)))
|
||||
(for-each
|
||||
(fn (d) (append! diagnostics d))
|
||||
(check-effect-call name caller-effects effect-annotations comp-name)))))
|
||||
|
||||
;; Primitive call — check param types
|
||||
(when (and (not (starts-with? name "~"))
|
||||
(not (nil? prim-param-types))
|
||||
(dict-has? prim-param-types name))
|
||||
(has-key? prim-param-types name))
|
||||
(for-each
|
||||
(fn (d) (append! diagnostics d))
|
||||
(check-primitive-call name args type-env prim-types
|
||||
prim-param-types comp-name)))
|
||||
prim-param-types comp-name type-registry)))
|
||||
|
||||
;; Effect check for function calls
|
||||
(when (and (not (starts-with? name "~"))
|
||||
(not (nil? effect-annotations)))
|
||||
(let ((caller-effects (get-effects comp-name effect-annotations)))
|
||||
(for-each
|
||||
(fn (d) (append! diagnostics d))
|
||||
(check-effect-call name caller-effects effect-annotations comp-name))))
|
||||
|
||||
;; Recurse into let with extended type env
|
||||
(when (or (= name "let") (= name "let*"))
|
||||
@@ -524,12 +559,12 @@
|
||||
(let ((bname (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(str (first binding))))
|
||||
(val-type (infer-type (nth binding 1) extended prim-types)))
|
||||
(val-type (infer-type (nth binding 1) extended prim-types type-registry)))
|
||||
(dict-set! extended bname val-type))))
|
||||
bindings)
|
||||
(for-each
|
||||
(fn (body)
|
||||
(check-body-walk body comp-name extended prim-types prim-param-types env diagnostics))
|
||||
(check-body-walk body comp-name extended prim-types prim-param-types env diagnostics type-registry effect-annotations))
|
||||
body-exprs))))
|
||||
|
||||
;; Recurse into define with type binding
|
||||
@@ -541,13 +576,13 @@
|
||||
(def-val (nth args 1)))
|
||||
(when def-name
|
||||
(dict-set! type-env def-name
|
||||
(infer-type def-val type-env prim-types)))
|
||||
(check-body-walk def-val comp-name type-env prim-types prim-param-types env diagnostics))))))
|
||||
(infer-type def-val type-env prim-types type-registry)))
|
||||
(check-body-walk def-val comp-name type-env prim-types prim-param-types env diagnostics type-registry effect-annotations))))))
|
||||
|
||||
;; Recurse into all child expressions
|
||||
(for-each
|
||||
(fn (child)
|
||||
(check-body-walk child comp-name type-env prim-types prim-param-types env diagnostics))
|
||||
(check-body-walk child comp-name type-env prim-types prim-param-types env diagnostics type-registry effect-annotations))
|
||||
args)))))))
|
||||
|
||||
|
||||
@@ -556,9 +591,11 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-component
|
||||
(fn ((comp-name :as string) env (prim-types :as dict) prim-param-types)
|
||||
(fn ((comp-name :as string) env (prim-types :as dict) prim-param-types type-registry effect-annotations)
|
||||
;; Type-check a component's body. Returns list of diagnostics.
|
||||
;; prim-param-types: dict of param type info, or nil to skip primitive checking.
|
||||
;; type-registry: dict of {type-name → type-def} or nil
|
||||
;; effect-annotations: dict of {fn-name → effect-list} or nil
|
||||
(let ((comp (env-get env comp-name))
|
||||
(diagnostics (list)))
|
||||
(when (= (type-of comp) "component")
|
||||
@@ -572,15 +609,15 @@
|
||||
(fn (p)
|
||||
(dict-set! type-env p
|
||||
(if (and (not (nil? param-types))
|
||||
(dict-has? param-types p))
|
||||
(dict-get param-types p)
|
||||
(has-key? param-types p))
|
||||
(get param-types p)
|
||||
"any")))
|
||||
params)
|
||||
;; Add children as (list-of element) if component has children
|
||||
(when (component-has-children comp)
|
||||
(dict-set! type-env "children" (list "list-of" "element")))
|
||||
|
||||
(check-body-walk body comp-name type-env prim-types prim-param-types env diagnostics)))
|
||||
(check-body-walk body comp-name type-env prim-types prim-param-types env diagnostics type-registry effect-annotations)))
|
||||
diagnostics)))
|
||||
|
||||
|
||||
@@ -589,9 +626,11 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-all
|
||||
(fn (env (prim-types :as dict) prim-param-types)
|
||||
(fn (env (prim-types :as dict) prim-param-types type-registry effect-annotations)
|
||||
;; Type-check every component in the environment.
|
||||
;; prim-param-types: dict of param type info, or nil to skip primitive checking.
|
||||
;; type-registry: dict of {type-name → type-def} or nil
|
||||
;; effect-annotations: dict of {fn-name → effect-list} or nil
|
||||
;; Returns list of all diagnostics.
|
||||
(let ((all-diagnostics (list)))
|
||||
(for-each
|
||||
@@ -600,7 +639,7 @@
|
||||
(when (= (type-of val) "component")
|
||||
(for-each
|
||||
(fn (d) (append! all-diagnostics d))
|
||||
(check-component name env prim-types prim-param-types)))))
|
||||
(check-component name env prim-types prim-param-types type-registry effect-annotations)))))
|
||||
(keys env))
|
||||
all-diagnostics)))
|
||||
|
||||
@@ -619,21 +658,208 @@
|
||||
(let ((registry (dict)))
|
||||
(for-each
|
||||
(fn (decl)
|
||||
(let ((name (dict-get decl "name"))
|
||||
(returns (dict-get decl "returns")))
|
||||
(let ((name (get decl "name"))
|
||||
(returns (get decl "returns")))
|
||||
(when (and (not (nil? name)) (not (nil? returns)))
|
||||
(dict-set! registry name returns))))
|
||||
prim-declarations)
|
||||
(for-each
|
||||
(fn (decl)
|
||||
(let ((name (dict-get decl "name"))
|
||||
(returns (dict-get decl "returns")))
|
||||
(let ((name (get decl "name"))
|
||||
(returns (get decl "returns")))
|
||||
(when (and (not (nil? name)) (not (nil? returns)))
|
||||
(dict-set! registry name returns))))
|
||||
io-declarations)
|
||||
registry)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 13. User-defined types (deftype)
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type definitions are plain dicts: {:name "price" :params [] :body "number"}
|
||||
;; Stored in env under "*type-registry*" mapping type names to defs.
|
||||
|
||||
;; make-type-def and normalize-type-body are defined in eval.sx
|
||||
;; (always compiled). They're available when types.sx is compiled as a spec module.
|
||||
|
||||
;; -- Standard type definitions --
|
||||
;; These define the record types used throughout the type system itself.
|
||||
|
||||
;; Universal: nullable shorthand
|
||||
(deftype (maybe a) (union a nil))
|
||||
|
||||
;; A type definition entry in the registry
|
||||
(deftype type-def
|
||||
{:name string :params list :body any})
|
||||
|
||||
;; A diagnostic produced by the type checker
|
||||
(deftype diagnostic
|
||||
{:level string :message string :component string? :expr any})
|
||||
|
||||
;; Primitive parameter type signature
|
||||
(deftype prim-param-sig
|
||||
{:positional list :rest-type string?})
|
||||
|
||||
;; Effect declarations
|
||||
(defeffect io)
|
||||
(defeffect mutation)
|
||||
(defeffect render)
|
||||
|
||||
(define type-def-name
|
||||
(fn (td) (get td "name")))
|
||||
|
||||
(define type-def-params
|
||||
(fn (td) (get td "params")))
|
||||
|
||||
(define type-def-body
|
||||
(fn (td) (get td "body")))
|
||||
|
||||
(define resolve-type
|
||||
(fn (t registry)
|
||||
;; Resolve a type through the registry.
|
||||
;; Returns the resolved type representation.
|
||||
(if (nil? registry) t
|
||||
(cond
|
||||
;; String — might be a named type alias
|
||||
(= (type-of t) "string")
|
||||
(if (has-key? registry t)
|
||||
(let ((td (get registry t)))
|
||||
(let ((params (type-def-params td))
|
||||
(body (type-def-body td)))
|
||||
(if (empty? params)
|
||||
;; Simple alias — resolve the body recursively
|
||||
(resolve-type body registry)
|
||||
;; Parameterized with no args — return as-is
|
||||
t)))
|
||||
t)
|
||||
;; List — might be parameterized type application or compound
|
||||
(= (type-of t) "list")
|
||||
(if (empty? t) t
|
||||
(let ((head (first t)))
|
||||
(cond
|
||||
;; (or ...), (list-of ...), (-> ...) — recurse into members
|
||||
(or (= head "or") (= head "list-of") (= head "->")
|
||||
(= head "dict-of"))
|
||||
(cons head (map (fn (m) (resolve-type m registry)) (rest t)))
|
||||
;; Parameterized type application: ("maybe" "string") etc.
|
||||
(and (= (type-of head) "string")
|
||||
(has-key? registry head))
|
||||
(let ((td (get registry head))
|
||||
(params (type-def-params td))
|
||||
(body (type-def-body td))
|
||||
(args (rest t)))
|
||||
(if (= (len params) (len args))
|
||||
(resolve-type
|
||||
(substitute-type-vars body params args)
|
||||
registry)
|
||||
;; Wrong arity — return as-is
|
||||
t))
|
||||
:else t)))
|
||||
;; Dict — record type, resolve field types
|
||||
(= (type-of t) "dict")
|
||||
(map-dict (fn (k v) (resolve-type v registry)) t)
|
||||
;; Anything else — return as-is
|
||||
:else t))))
|
||||
|
||||
(define substitute-type-vars
|
||||
(fn (body (params :as list) (args :as list))
|
||||
;; Substitute type variables in body.
|
||||
;; params is a list of type var names, args is corresponding types.
|
||||
(let ((subst (dict)))
|
||||
(for-each
|
||||
(fn (i)
|
||||
(dict-set! subst (nth params i) (nth args i)))
|
||||
(range 0 (len params) 1))
|
||||
(substitute-in-type body subst))))
|
||||
|
||||
(define substitute-in-type
|
||||
(fn (t (subst :as dict))
|
||||
;; Recursively substitute type variables.
|
||||
(cond
|
||||
(= (type-of t) "string")
|
||||
(if (has-key? subst t) (get subst t) t)
|
||||
(= (type-of t) "list")
|
||||
(map (fn (m) (substitute-in-type m subst)) t)
|
||||
(= (type-of t) "dict")
|
||||
(map-dict (fn (k v) (substitute-in-type v subst)) t)
|
||||
:else t)))
|
||||
|
||||
(define subtype-resolved?
|
||||
(fn (a b registry)
|
||||
;; Resolve both sides through the registry, then check subtype.
|
||||
(if (nil? registry)
|
||||
(subtype? a b)
|
||||
(let ((ra (resolve-type a registry))
|
||||
(rb (resolve-type b registry)))
|
||||
;; Handle record structural subtyping: dict a <: dict b
|
||||
;; if every field in b exists in a with compatible type
|
||||
(if (and (= (type-of ra) "dict") (= (type-of rb) "dict"))
|
||||
(every?
|
||||
(fn (key)
|
||||
(and (has-key? ra key)
|
||||
(subtype-resolved? (get ra key) (get rb key) registry)))
|
||||
(keys rb))
|
||||
(subtype? ra rb))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 14. Effect checking (defeffect)
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Effects are annotations on functions/components describing their
|
||||
;; side effects. A pure function cannot call IO functions.
|
||||
|
||||
(define get-effects
|
||||
(fn ((name :as string) effect-annotations)
|
||||
;; Look up declared effects for a function/component.
|
||||
;; Returns list of effect strings, or nil if unannotated.
|
||||
(if (nil? effect-annotations) nil
|
||||
(if (has-key? effect-annotations name)
|
||||
(get effect-annotations name)
|
||||
nil))))
|
||||
|
||||
(define effects-subset?
|
||||
(fn (callee-effects caller-effects)
|
||||
;; Are all callee effects allowed by caller?
|
||||
;; nil effects = unannotated = assumed to have all effects.
|
||||
;; Empty list = pure = no effects.
|
||||
(if (nil? caller-effects) true ;; unannotated caller allows everything
|
||||
(if (nil? callee-effects) true ;; unannotated callee — skip check
|
||||
(every?
|
||||
(fn (e) (contains? caller-effects e))
|
||||
callee-effects)))))
|
||||
|
||||
(define check-effect-call
|
||||
(fn ((callee-name :as string) caller-effects effect-annotations (comp-name :as string))
|
||||
;; Check that callee's effects are allowed by caller's effects.
|
||||
;; Returns list of diagnostics.
|
||||
(let ((diagnostics (list))
|
||||
(callee-effects (get-effects callee-name effect-annotations)))
|
||||
(when (and (not (nil? caller-effects))
|
||||
(not (nil? callee-effects))
|
||||
(not (effects-subset? callee-effects caller-effects)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "`" callee-name "` has effects "
|
||||
(join ", " callee-effects)
|
||||
" but `" comp-name "` only allows "
|
||||
(if (empty? caller-effects) "[pure]"
|
||||
(join ", " caller-effects)))
|
||||
comp-name nil)))
|
||||
diagnostics)))
|
||||
|
||||
(define build-effect-annotations
|
||||
(fn ((io-declarations :as list))
|
||||
;; Assign [io] effect to all IO primitives.
|
||||
(let ((annotations (dict)))
|
||||
(for-each
|
||||
(fn (decl)
|
||||
(let ((name (get decl "name")))
|
||||
(when (not (nil? name))
|
||||
(dict-set! annotations name (list "io")))))
|
||||
io-declarations)
|
||||
annotations)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Platform interface summary
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
@@ -221,18 +221,30 @@ class Island:
|
||||
|
||||
@dataclass
|
||||
class HandlerDef:
|
||||
"""A declarative fragment handler defined in an .sx file.
|
||||
"""A declarative handler defined in an .sx file.
|
||||
|
||||
Created by ``(defhandler name (&key param...) body)``.
|
||||
The body is evaluated in a sandboxed environment with only
|
||||
s-expression primitives available.
|
||||
Created by ``(defhandler name :path "/..." :method :get (&key param...) body)``.
|
||||
|
||||
When ``path`` is set, the handler is registered as a public route.
|
||||
When ``path`` is None, it's an internal fragment handler (legacy behaviour).
|
||||
"""
|
||||
name: str
|
||||
params: list[str] # keyword parameter names
|
||||
body: Any # unevaluated s-expression body
|
||||
closure: dict[str, Any] = field(default_factory=dict)
|
||||
path: str | None = None # public route path (None = internal fragment only)
|
||||
method: str = "get" # HTTP method (get, post, put, patch, delete)
|
||||
csrf: bool = True # CSRF protection enabled
|
||||
returns: str = "element" # return type (types.sx vocabulary)
|
||||
|
||||
@property
|
||||
def is_route(self) -> bool:
|
||||
"""True if this handler has a public route path."""
|
||||
return self.path is not None
|
||||
|
||||
def __repr__(self):
|
||||
if self.path:
|
||||
return f"<handler:{self.name} {self.method.upper()} {self.path}>"
|
||||
return f"<handler:{self.name}({', '.join(self.params)})>"
|
||||
|
||||
|
||||
|
||||
@@ -103,6 +103,14 @@ def create_app() -> "Quart":
|
||||
bp = register_pages(url_prefix="/")
|
||||
app.register_blueprint(bp)
|
||||
|
||||
# Register SX-defined route handlers (defhandler with :path)
|
||||
from shared.sx.handlers import register_route_handlers
|
||||
n_routes = register_route_handlers(app, "sx")
|
||||
if n_routes:
|
||||
import logging
|
||||
logging.getLogger("sx.handlers").info(
|
||||
"Registered %d route handler(s) for sx", n_routes)
|
||||
|
||||
from shared.sx.pages import auto_mount_pages
|
||||
auto_mount_pages(app, "sx")
|
||||
|
||||
|
||||
@@ -1,895 +1,28 @@
|
||||
"""SX docs page routes.
|
||||
|
||||
Page GET routes are defined declaratively in sxc/pages/docs.sx via defpage.
|
||||
This file contains only redirect routes and example API endpoints.
|
||||
Example API endpoints are now defined in sx/handlers/examples.sx via defhandler.
|
||||
This file contains only SSE and marsh demo endpoints that need Python.
|
||||
"""
|
||||
from __future__ import annotations
|
||||
|
||||
import asyncio
|
||||
import json
|
||||
import random
|
||||
from datetime import datetime
|
||||
from uuid import uuid4
|
||||
|
||||
from quart import Blueprint, Response, make_response, request
|
||||
from shared.browser.app.csrf import csrf_exempt
|
||||
from quart import Blueprint, Response, request
|
||||
|
||||
|
||||
def register(url_prefix: str = "/") -> Blueprint:
|
||||
bp = Blueprint("pages", __name__, url_prefix=url_prefix)
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
# Example API endpoints (for live demos)
|
||||
# Reference API endpoints — remaining Python-only
|
||||
#
|
||||
# Most reference endpoints migrated to sx/sx/handlers/ref-api.sx.
|
||||
# SSE stays in Python — fundamentally different paradigm (async generator).
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/click")
|
||||
async def api_click():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
now = datetime.now().strftime("%Y-%m-%d %H:%M:%S")
|
||||
sx_src = f'(~click-result :time "{now}")'
|
||||
comp_text = _component_source_text("click-result")
|
||||
wire_text = _full_wire_text(sx_src, "click-result")
|
||||
oob_wire = _oob_code("click-wire", wire_text)
|
||||
oob_comp = _oob_code("click-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/form")
|
||||
async def api_form():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
form = await request.form
|
||||
name = form.get("name", "")
|
||||
escaped = name.replace('"', '\\"')
|
||||
sx_src = f'(~form-result :name "{escaped}")'
|
||||
comp_text = _component_source_text("form-result")
|
||||
wire_text = _full_wire_text(sx_src, "form-result")
|
||||
oob_wire = _oob_code("form-wire", wire_text)
|
||||
oob_comp = _oob_code("form-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
_poll_count = {"n": 0}
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/poll")
|
||||
async def api_poll():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
_poll_count["n"] += 1
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
count = min(_poll_count["n"], 10)
|
||||
sx_src = f'(~poll-result :time "{now}" :count {count})'
|
||||
comp_text = _component_source_text("poll-result")
|
||||
wire_text = _full_wire_text(sx_src, "poll-result")
|
||||
oob_wire = _oob_code("poll-wire", wire_text)
|
||||
oob_comp = _oob_code("poll-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.delete("/geography/hypermedia/examples/api/delete/<item_id>")
|
||||
async def api_delete(item_id: str):
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
# Empty primary response — outerHTML swap removes the row
|
||||
# But send OOB swaps to show what happened
|
||||
wire_text = _full_wire_text(f'(empty — row #{item_id} removed by outerHTML swap)')
|
||||
comp_text = _component_source_text("delete-row")
|
||||
oob_wire = _oob_code("delete-wire", wire_text)
|
||||
oob_comp = _oob_code("delete-comp", comp_text)
|
||||
return sx_response(f'(<> {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/edit")
|
||||
async def api_edit_form():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
value = request.args.get("value", "")
|
||||
escaped = value.replace('"', '\\"')
|
||||
sx_src = f'(~inline-edit-form :value "{escaped}")'
|
||||
comp_text = _component_source_text("inline-edit-form")
|
||||
wire_text = _full_wire_text(sx_src, "inline-edit-form")
|
||||
oob_wire = _oob_code("edit-wire", wire_text)
|
||||
oob_comp = _oob_code("edit-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/edit")
|
||||
async def api_edit_save():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
form = await request.form
|
||||
value = form.get("value", "")
|
||||
escaped = value.replace('"', '\\"')
|
||||
sx_src = f'(~inline-view :value "{escaped}")'
|
||||
comp_text = _component_source_text("inline-view")
|
||||
wire_text = _full_wire_text(sx_src, "inline-view")
|
||||
oob_wire = _oob_code("edit-wire", wire_text)
|
||||
oob_comp = _oob_code("edit-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/edit/cancel")
|
||||
async def api_edit_cancel():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
value = request.args.get("value", "")
|
||||
escaped = value.replace('"', '\\"')
|
||||
sx_src = f'(~inline-view :value "{escaped}")'
|
||||
comp_text = _component_source_text("inline-view")
|
||||
wire_text = _full_wire_text(sx_src, "inline-view")
|
||||
oob_wire = _oob_code("edit-wire", wire_text)
|
||||
oob_comp = _oob_code("edit-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/oob")
|
||||
async def api_oob():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = (
|
||||
f'(<>'
|
||||
f' (p :class "text-emerald-600 font-medium" "Box A updated!")'
|
||||
f' (p :class "text-sm text-stone-500" "at {now}")'
|
||||
f' (div :id "oob-box-b" :sx-swap-oob "innerHTML"'
|
||||
f' (p :class "text-violet-600 font-medium" "Box B updated via OOB!")'
|
||||
f' (p :class "text-sm text-stone-500" "at {now}")))'
|
||||
)
|
||||
wire_text = _full_wire_text(sx_src)
|
||||
oob_wire = _oob_code("oob-wire", wire_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire})')
|
||||
|
||||
# --- Lazy Loading ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/lazy")
|
||||
async def api_lazy():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(~lazy-result :time "{now}")'
|
||||
comp_text = _component_source_text("lazy-result")
|
||||
wire_text = _full_wire_text(sx_src, "lazy-result")
|
||||
oob_wire = _oob_code("lazy-wire", wire_text)
|
||||
oob_comp = _oob_code("lazy-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Infinite Scroll ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/scroll")
|
||||
async def api_scroll():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
page = int(request.args.get("page", 2))
|
||||
start = (page - 1) * 5 + 1
|
||||
next_page = page + 1
|
||||
items_html = " ".join(
|
||||
f'(div :class "px-4 py-3 border-b border-stone-100 text-sm text-stone-700" "Item {i} — loaded from page {page}")'
|
||||
for i in range(start, start + 5)
|
||||
)
|
||||
if next_page <= 6:
|
||||
sentinel = (
|
||||
f'(div :id "scroll-sentinel"'
|
||||
f' :sx-get "/geography/hypermedia/examples/api/scroll?page={next_page}"'
|
||||
f' :sx-trigger "intersect once"'
|
||||
f' :sx-target "#scroll-items"'
|
||||
f' :sx-swap "beforeend"'
|
||||
f' :class "p-3 text-center text-stone-400 text-sm"'
|
||||
f' "Loading more...")'
|
||||
)
|
||||
else:
|
||||
sentinel = (
|
||||
'(div :class "p-3 text-center text-stone-500 text-sm font-medium"'
|
||||
' "All items loaded.")'
|
||||
)
|
||||
sx_src = f'(<> {items_html} {sentinel})'
|
||||
wire_text = _full_wire_text(sx_src)
|
||||
oob_wire = _oob_code("scroll-wire", wire_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire})')
|
||||
|
||||
# --- Progress Bar ---
|
||||
|
||||
_jobs: dict[str, int] = {}
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/progress/start")
|
||||
async def api_progress_start():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
job_id = str(uuid4())[:8]
|
||||
_jobs[job_id] = 0
|
||||
sx_src = f'(~progress-status :percent 0 :job-id "{job_id}")'
|
||||
comp_text = _component_source_text("progress-status")
|
||||
wire_text = _full_wire_text(sx_src, "progress-status")
|
||||
oob_wire = _oob_code("progress-wire", wire_text)
|
||||
oob_comp = _oob_code("progress-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/progress/status")
|
||||
async def api_progress_status():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
job_id = request.args.get("job", "")
|
||||
current = _jobs.get(job_id, 0)
|
||||
current = min(current + random.randint(15, 30), 100)
|
||||
_jobs[job_id] = current
|
||||
sx_src = f'(~progress-status :percent {current} :job-id "{job_id}")'
|
||||
comp_text = _component_source_text("progress-status")
|
||||
wire_text = _full_wire_text(sx_src, "progress-status")
|
||||
oob_wire = _oob_code("progress-wire", wire_text)
|
||||
oob_comp = _oob_code("progress-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Active Search ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/search")
|
||||
async def api_search():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
from content.pages import SEARCH_LANGUAGES
|
||||
q = request.args.get("q", "").strip().lower()
|
||||
if not q:
|
||||
results = SEARCH_LANGUAGES
|
||||
else:
|
||||
results = [lang for lang in SEARCH_LANGUAGES if q in lang.lower()]
|
||||
items_sx = " ".join(f'"{r}"' for r in results)
|
||||
escaped_q = q.replace('"', '\\"')
|
||||
sx_src = f'(~search-results :items (list {items_sx}) :query "{escaped_q}")'
|
||||
comp_text = _component_source_text("search-results")
|
||||
wire_text = _full_wire_text(sx_src, "search-results")
|
||||
oob_wire = _oob_code("search-wire", wire_text)
|
||||
oob_comp = _oob_code("search-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Inline Validation ---
|
||||
|
||||
_TAKEN_EMAILS = {"admin@example.com", "test@example.com", "user@example.com"}
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/validate")
|
||||
async def api_validate():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
email = request.args.get("email", "").strip()
|
||||
if not email:
|
||||
sx_src = '(~validation-error :message "Email is required")'
|
||||
comp_name = "validation-error"
|
||||
elif "@" not in email or "." not in email.split("@")[-1]:
|
||||
sx_src = '(~validation-error :message "Invalid email format")'
|
||||
comp_name = "validation-error"
|
||||
elif email.lower() in _TAKEN_EMAILS:
|
||||
escaped = email.replace('"', '\\"')
|
||||
sx_src = f'(~validation-error :message "{escaped} is already taken")'
|
||||
comp_name = "validation-error"
|
||||
else:
|
||||
escaped = email.replace('"', '\\"')
|
||||
sx_src = f'(~validation-ok :email "{escaped}")'
|
||||
comp_name = "validation-ok"
|
||||
comp_text = _component_source_text(comp_name)
|
||||
wire_text = _full_wire_text(sx_src, comp_name)
|
||||
oob_wire = _oob_code("validate-wire", wire_text)
|
||||
oob_comp = _oob_code("validate-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/validate/submit")
|
||||
async def api_validate_submit():
|
||||
from shared.sx.helpers import sx_response
|
||||
form = await request.form
|
||||
email = form.get("email", "").strip()
|
||||
if not email or "@" not in email:
|
||||
return sx_response('(p :class "text-sm text-rose-600 mt-2" "Please enter a valid email.")')
|
||||
escaped = email.replace('"', '\\"')
|
||||
return sx_response(f'(p :class "text-sm text-emerald-600 mt-2" "Form submitted with: {escaped}")')
|
||||
|
||||
# --- Value Select ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/values")
|
||||
async def api_values():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
from content.pages import VALUE_SELECT_DATA
|
||||
cat = request.args.get("category", "")
|
||||
items = VALUE_SELECT_DATA.get(cat, [])
|
||||
options_sx = " ".join(f'(option :value "{i}" "{i}")' for i in items)
|
||||
if not options_sx:
|
||||
options_sx = '(option :value "" "No items")'
|
||||
sx_src = f'(<> {options_sx})'
|
||||
wire_text = _full_wire_text(sx_src)
|
||||
oob_wire = _oob_code("values-wire", wire_text)
|
||||
return sx_response(f'(<> {options_sx} {oob_wire})')
|
||||
|
||||
# --- Reset on Submit ---
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/reset-submit")
|
||||
async def api_reset_submit():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
form = await request.form
|
||||
msg = form.get("message", "").strip() or "(empty)"
|
||||
escaped = msg.replace('"', '\\"')
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(~reset-message :message "{escaped}" :time "{now}")'
|
||||
comp_text = _component_source_text("reset-message")
|
||||
wire_text = _full_wire_text(sx_src, "reset-message")
|
||||
oob_wire = _oob_code("reset-wire", wire_text)
|
||||
oob_comp = _oob_code("reset-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Edit Row ---
|
||||
|
||||
_edit_rows: dict[str, dict] = {}
|
||||
|
||||
def _get_edit_rows() -> dict[str, dict]:
|
||||
if not _edit_rows:
|
||||
from content.pages import EDIT_ROW_DATA
|
||||
for r in EDIT_ROW_DATA:
|
||||
_edit_rows[r["id"]] = dict(r)
|
||||
return _edit_rows
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/editrow/<row_id>")
|
||||
async def api_editrow_form(row_id: str):
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
rows = _get_edit_rows()
|
||||
row = rows.get(row_id, {"id": row_id, "name": "", "price": "0", "stock": "0"})
|
||||
sx_src = (f'(~edit-row-form :id "{row["id"]}" :name "{row["name"]}"'
|
||||
f' :price "{row["price"]}" :stock "{row["stock"]}")')
|
||||
comp_text = _component_source_text("edit-row-form")
|
||||
wire_text = _full_wire_text(sx_src, "edit-row-form")
|
||||
oob_wire = _oob_code("editrow-wire", wire_text)
|
||||
oob_comp = _oob_code("editrow-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/editrow/<row_id>")
|
||||
async def api_editrow_save(row_id: str):
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
form = await request.form
|
||||
rows = _get_edit_rows()
|
||||
rows[row_id] = {
|
||||
"id": row_id,
|
||||
"name": form.get("name", ""),
|
||||
"price": form.get("price", "0"),
|
||||
"stock": form.get("stock", "0"),
|
||||
}
|
||||
row = rows[row_id]
|
||||
sx_src = (f'(~edit-row-view :id "{row["id"]}" :name "{row["name"]}"'
|
||||
f' :price "{row["price"]}" :stock "{row["stock"]}")')
|
||||
comp_text = _component_source_text("edit-row-view")
|
||||
wire_text = _full_wire_text(sx_src, "edit-row-view")
|
||||
oob_wire = _oob_code("editrow-wire", wire_text)
|
||||
oob_comp = _oob_code("editrow-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/editrow/<row_id>/cancel")
|
||||
async def api_editrow_cancel(row_id: str):
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
rows = _get_edit_rows()
|
||||
row = rows.get(row_id, {"id": row_id, "name": "", "price": "0", "stock": "0"})
|
||||
sx_src = (f'(~edit-row-view :id "{row["id"]}" :name "{row["name"]}"'
|
||||
f' :price "{row["price"]}" :stock "{row["stock"]}")')
|
||||
comp_text = _component_source_text("edit-row-view")
|
||||
wire_text = _full_wire_text(sx_src, "edit-row-view")
|
||||
oob_wire = _oob_code("editrow-wire", wire_text)
|
||||
oob_comp = _oob_code("editrow-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Bulk Update ---
|
||||
|
||||
_bulk_users: dict[str, dict] = {}
|
||||
|
||||
def _get_bulk_users() -> dict[str, dict]:
|
||||
if not _bulk_users:
|
||||
from content.pages import BULK_USERS
|
||||
for u in BULK_USERS:
|
||||
_bulk_users[u["id"]] = dict(u)
|
||||
return _bulk_users
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/bulk")
|
||||
async def api_bulk():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
action = request.args.get("action", "activate")
|
||||
form = await request.form
|
||||
ids = form.getlist("ids")
|
||||
users = _get_bulk_users()
|
||||
new_status = "active" if action == "activate" else "inactive"
|
||||
for uid in ids:
|
||||
if uid in users:
|
||||
users[uid]["status"] = new_status
|
||||
rows = []
|
||||
for u in users.values():
|
||||
rows.append(
|
||||
f'(~bulk-row :id "{u["id"]}" :name "{u["name"]}"'
|
||||
f' :email "{u["email"]}" :status "{u["status"]}")'
|
||||
)
|
||||
sx_src = f'(<> {" ".join(rows)})'
|
||||
comp_text = _component_source_text("bulk-row")
|
||||
wire_text = _full_wire_text(sx_src, "bulk-row")
|
||||
oob_wire = _oob_code("bulk-wire", wire_text)
|
||||
oob_comp = _oob_code("bulk-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Swap Positions ---
|
||||
|
||||
_swap_count = {"n": 0}
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/swap-log")
|
||||
async def api_swap_log():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
mode = request.args.get("mode", "beforeend")
|
||||
_swap_count["n"] += 1
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
n = _swap_count["n"]
|
||||
entry = f'(div :class "px-3 py-2 text-sm text-stone-700" "[{now}] {mode} (#{n})")'
|
||||
oob_counter = (
|
||||
f'(span :id "swap-counter" :sx-swap-oob "innerHTML"'
|
||||
f' :class "self-center text-sm text-stone-500" "Count: {n}")'
|
||||
)
|
||||
sx_src = f'(<> {entry} {oob_counter})'
|
||||
wire_text = _full_wire_text(sx_src)
|
||||
oob_wire = _oob_code("swap-wire", wire_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire})')
|
||||
|
||||
# --- Select Filter (dashboard) ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/dashboard")
|
||||
async def api_dashboard():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = (
|
||||
f'(<>'
|
||||
f' (div :id "dash-header" :class "p-3 bg-violet-50 rounded mb-3"'
|
||||
f' (h4 :class "font-semibold text-violet-800" "Dashboard Header")'
|
||||
f' (p :class "text-sm text-violet-600" "Generated at {now}"))'
|
||||
f' (div :id "dash-stats" :class "grid grid-cols-3 gap-3 mb-3"'
|
||||
f' (div :class "p-3 bg-emerald-50 rounded text-center"'
|
||||
f' (p :class "text-2xl font-bold text-emerald-700" "142")'
|
||||
f' (p :class "text-xs text-emerald-600" "Users"))'
|
||||
f' (div :class "p-3 bg-blue-50 rounded text-center"'
|
||||
f' (p :class "text-2xl font-bold text-blue-700" "89")'
|
||||
f' (p :class "text-xs text-blue-600" "Orders"))'
|
||||
f' (div :class "p-3 bg-amber-50 rounded text-center"'
|
||||
f' (p :class "text-2xl font-bold text-amber-700" "$4.2k")'
|
||||
f' (p :class "text-xs text-amber-600" "Revenue")))'
|
||||
f' (div :id "dash-footer" :class "p-3 bg-stone-50 rounded"'
|
||||
f' (p :class "text-sm text-stone-500" "Last updated: {now}")))'
|
||||
)
|
||||
wire_text = _full_wire_text(sx_src)
|
||||
oob_wire = _oob_code("filter-wire", wire_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire})')
|
||||
|
||||
# --- Tabs ---
|
||||
|
||||
_TAB_CONTENT = {
|
||||
"tab1": ('(div (p :class "text-stone-700" "Welcome to the Overview tab.")'
|
||||
' (p :class "text-stone-500 text-sm mt-2"'
|
||||
' "This is the default tab content loaded via sx-get."))'),
|
||||
"tab2": ('(div (p :class "text-stone-700" "Here are the details.")'
|
||||
' (ul :class "mt-2 space-y-1 text-sm text-stone-600"'
|
||||
' (li "Version: 1.0.0")'
|
||||
' (li "Build: 2024-01-15")'
|
||||
' (li "Engine: sx")))'),
|
||||
"tab3": ('(div (p :class "text-stone-700" "Recent history:")'
|
||||
' (ol :class "mt-2 space-y-1 text-sm text-stone-600 list-decimal list-inside"'
|
||||
' (li "Initial release")'
|
||||
' (li "Added component caching")'
|
||||
' (li "Wire format v2")))'),
|
||||
}
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/tabs/<tab>")
|
||||
async def api_tabs(tab: str):
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
sx_src = _TAB_CONTENT.get(tab, _TAB_CONTENT["tab1"])
|
||||
buttons = []
|
||||
for t, label in [("tab1", "Overview"), ("tab2", "Details"), ("tab3", "History")]:
|
||||
active = "true" if t == tab else "false"
|
||||
buttons.append(f'(~tab-btn :tab "{t}" :label "{label}" :active "{active}")')
|
||||
oob_tabs = (
|
||||
f'(div :id "tab-buttons" :sx-swap-oob "innerHTML"'
|
||||
f' :class "flex border-b border-stone-200"'
|
||||
f' {" ".join(buttons)})'
|
||||
)
|
||||
wire_text = _full_wire_text(f'(<> {sx_src} {oob_tabs})', "tab-btn")
|
||||
oob_wire = _oob_code("tabs-wire", wire_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_tabs} {oob_wire})')
|
||||
|
||||
# --- Animations ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/animate")
|
||||
async def api_animate():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
colors = ["bg-violet-100", "bg-emerald-100", "bg-blue-100", "bg-amber-100", "bg-rose-100"]
|
||||
color = random.choice(colors)
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(~anim-result :color "{color}" :time "{now}")'
|
||||
comp_text = _component_source_text("anim-result")
|
||||
wire_text = _full_wire_text(sx_src, "anim-result")
|
||||
oob_wire = _oob_code("anim-wire", wire_text)
|
||||
oob_comp = _oob_code("anim-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Dialogs ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/dialog")
|
||||
async def api_dialog():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
sx_src = '(~dialog-modal :title "Confirm Action" :message "Are you sure you want to proceed? This is a demo dialog rendered entirely with sx components.")'
|
||||
comp_text = _component_source_text("dialog-modal")
|
||||
wire_text = _full_wire_text(sx_src, "dialog-modal")
|
||||
oob_wire = _oob_code("dialog-wire", wire_text)
|
||||
oob_comp = _oob_code("dialog-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/dialog/close")
|
||||
async def api_dialog_close():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _full_wire_text
|
||||
wire_text = _full_wire_text("(empty — dialog closed)")
|
||||
oob_wire = _oob_code("dialog-wire", wire_text)
|
||||
return sx_response(f'(<> {oob_wire})')
|
||||
|
||||
# --- Keyboard Shortcuts ---
|
||||
|
||||
_KBD_ACTIONS = {
|
||||
"s": "Search panel activated",
|
||||
"n": "New item created",
|
||||
"h": "Help panel opened",
|
||||
}
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/keyboard")
|
||||
async def api_keyboard():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
key = request.args.get("key", "")
|
||||
action = _KBD_ACTIONS.get(key, f"Unknown key: {key}")
|
||||
escaped_action = action.replace('"', '\\"')
|
||||
escaped_key = key.replace('"', '\\"')
|
||||
sx_src = f'(~kbd-result :key "{escaped_key}" :action "{escaped_action}")'
|
||||
comp_text = _component_source_text("kbd-result")
|
||||
wire_text = _full_wire_text(sx_src, "kbd-result")
|
||||
oob_wire = _oob_code("kbd-wire", wire_text)
|
||||
oob_comp = _oob_code("kbd-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- PUT / PATCH ---
|
||||
|
||||
_profile = {}
|
||||
|
||||
def _get_profile() -> dict:
|
||||
if not _profile:
|
||||
from content.pages import PROFILE_DEFAULT
|
||||
_profile.update(PROFILE_DEFAULT)
|
||||
return _profile
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/putpatch/edit-all")
|
||||
async def api_pp_edit_all():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
p = _get_profile()
|
||||
sx_src = f'(~pp-form-full :name "{p["name"]}" :email "{p["email"]}" :role "{p["role"]}")'
|
||||
comp_text = _component_source_text("pp-form-full")
|
||||
wire_text = _full_wire_text(sx_src, "pp-form-full")
|
||||
oob_wire = _oob_code("pp-wire", wire_text)
|
||||
oob_comp = _oob_code("pp-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.put("/geography/hypermedia/examples/api/putpatch")
|
||||
async def api_pp_put():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
form = await request.form
|
||||
p = _get_profile()
|
||||
p["name"] = form.get("name", p["name"])
|
||||
p["email"] = form.get("email", p["email"])
|
||||
p["role"] = form.get("role", p["role"])
|
||||
sx_src = f'(~pp-view :name "{p["name"]}" :email "{p["email"]}" :role "{p["role"]}")'
|
||||
comp_text = _component_source_text("pp-view")
|
||||
wire_text = _full_wire_text(sx_src, "pp-view")
|
||||
oob_wire = _oob_code("pp-wire", wire_text)
|
||||
oob_comp = _oob_code("pp-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/putpatch/cancel")
|
||||
async def api_pp_cancel():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
p = _get_profile()
|
||||
sx_src = f'(~pp-view :name "{p["name"]}" :email "{p["email"]}" :role "{p["role"]}")'
|
||||
comp_text = _component_source_text("pp-view")
|
||||
wire_text = _full_wire_text(sx_src, "pp-view")
|
||||
oob_wire = _oob_code("pp-wire", wire_text)
|
||||
oob_comp = _oob_code("pp-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- JSON Encoding ---
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/examples/api/json-echo")
|
||||
async def api_json_echo():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
data = await request.get_json(silent=True) or {}
|
||||
body = json.dumps(data, indent=2)
|
||||
ct = request.content_type or "unknown"
|
||||
escaped_body = body.replace('\\', '\\\\').replace('"', '\\"')
|
||||
escaped_ct = ct.replace('"', '\\"')
|
||||
sx_src = f'(~json-result :body "{escaped_body}" :content-type "{escaped_ct}")'
|
||||
comp_text = _component_source_text("json-result")
|
||||
wire_text = _full_wire_text(sx_src, "json-result")
|
||||
oob_wire = _oob_code("json-wire", wire_text)
|
||||
oob_comp = _oob_code("json-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Vals & Headers ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/echo-vals")
|
||||
async def api_echo_vals():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
vals = {k: v for k, v in request.args.items()
|
||||
if k not in ("_", "sx-request")}
|
||||
items_sx = " ".join(f'"{k}: {v}"' for k, v in vals.items())
|
||||
sx_src = f'(~echo-result :label "values" :items (list {items_sx}))'
|
||||
comp_text = _component_source_text("echo-result")
|
||||
wire_text = _full_wire_text(sx_src, "echo-result")
|
||||
oob_wire = _oob_code("vals-wire", wire_text)
|
||||
oob_comp = _oob_code("vals-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/echo-headers")
|
||||
async def api_echo_headers():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
custom = {k: v for k, v in request.headers if k.lower().startswith("x-")}
|
||||
items_sx = " ".join(f'"{k}: {v}"' for k, v in custom.items())
|
||||
sx_src = f'(~echo-result :label "headers" :items (list {items_sx}))'
|
||||
comp_text = _component_source_text("echo-result")
|
||||
wire_text = _full_wire_text(sx_src, "echo-result")
|
||||
oob_wire = _oob_code("vals-wire", wire_text)
|
||||
oob_comp = _oob_code("vals-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Loading States ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/slow")
|
||||
async def api_slow():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
await asyncio.sleep(2)
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(~loading-result :time "{now}")'
|
||||
comp_text = _component_source_text("loading-result")
|
||||
wire_text = _full_wire_text(sx_src, "loading-result")
|
||||
oob_wire = _oob_code("loading-wire", wire_text)
|
||||
oob_comp = _oob_code("loading-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Request Abort (sync replace) ---
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/slow-search")
|
||||
async def api_slow_search():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
delay = random.uniform(0.5, 2.0)
|
||||
await asyncio.sleep(delay)
|
||||
q = request.args.get("q", "").strip()
|
||||
delay_ms = int(delay * 1000)
|
||||
escaped = q.replace('"', '\\"')
|
||||
sx_src = f'(~sync-result :query "{escaped}" :delay "{delay_ms}")'
|
||||
comp_text = _component_source_text("sync-result")
|
||||
wire_text = _full_wire_text(sx_src, "sync-result")
|
||||
oob_wire = _oob_code("sync-wire", wire_text)
|
||||
oob_comp = _oob_code("sync-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# --- Retry ---
|
||||
|
||||
_flaky = {"n": 0}
|
||||
|
||||
@bp.get("/geography/hypermedia/examples/api/flaky")
|
||||
async def api_flaky():
|
||||
from shared.sx.helpers import sx_response
|
||||
from sxc.pages.renders import _oob_code, _component_source_text, _full_wire_text
|
||||
_flaky["n"] += 1
|
||||
n = _flaky["n"]
|
||||
if n % 3 != 0:
|
||||
return Response("", status=503, content_type="text/plain")
|
||||
sx_src = f'(~retry-result :attempt "{n}" :message "Success! The endpoint finally responded.")'
|
||||
comp_text = _component_source_text("retry-result")
|
||||
wire_text = _full_wire_text(sx_src, "retry-result")
|
||||
oob_wire = _oob_code("retry-wire", wire_text)
|
||||
oob_comp = _oob_code("retry-comp", comp_text)
|
||||
return sx_response(f'(<> {sx_src} {oob_wire} {oob_comp})')
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
# Reference attribute detail API endpoints (for live demos)
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
def _ref_wire(wire_id: str, sx_src: str) -> str:
|
||||
"""Build OOB swap showing the wire response text."""
|
||||
from sxc.pages.renders import _oob_code
|
||||
return _oob_code(f"ref-wire-{wire_id}", sx_src)
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/time")
|
||||
async def ref_time():
|
||||
from shared.sx.helpers import sx_response
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Server time: " (strong "{now}"))'
|
||||
oob = _ref_wire("sx-get", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/reference/api/greet")
|
||||
async def ref_greet():
|
||||
from shared.sx.helpers import sx_response
|
||||
form = await request.form
|
||||
name = form.get("name") or "stranger"
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Hello, " (strong "{name}") "!")'
|
||||
oob = _ref_wire("sx-post", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.put("/geography/hypermedia/reference/api/status")
|
||||
async def ref_status():
|
||||
from shared.sx.helpers import sx_response
|
||||
form = await request.form
|
||||
status = form.get("status", "unknown")
|
||||
sx_src = f'(span :class "text-stone-700 text-sm" "Status: " (strong "{status}") " — updated via PUT")'
|
||||
oob = _ref_wire("sx-put", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.patch("/geography/hypermedia/reference/api/theme")
|
||||
async def ref_theme():
|
||||
from shared.sx.helpers import sx_response
|
||||
form = await request.form
|
||||
theme = form.get("theme", "unknown")
|
||||
sx_src = f'"{theme}"'
|
||||
oob = _ref_wire("sx-patch", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.delete("/geography/hypermedia/reference/api/item/<item_id>")
|
||||
async def ref_delete(item_id: str):
|
||||
from shared.sx.helpers import sx_response
|
||||
oob = _ref_wire("sx-delete", '""')
|
||||
return sx_response(f'(<> {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/trigger-search")
|
||||
async def ref_trigger_search():
|
||||
from shared.sx.helpers import sx_response
|
||||
q = request.args.get("q", "")
|
||||
if not q:
|
||||
sx_src = '(span :class "text-stone-400 text-sm" "Start typing to trigger a search.")'
|
||||
else:
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Results for: " (strong "{q}"))'
|
||||
oob = _ref_wire("sx-trigger", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/swap-item")
|
||||
async def ref_swap_item():
|
||||
from shared.sx.helpers import sx_response
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(div :class "text-sm text-violet-700" "New item (" "{now}" ")")'
|
||||
oob = _ref_wire("sx-swap", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/oob")
|
||||
async def ref_oob():
|
||||
from shared.sx.helpers import sx_response
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = (
|
||||
f'(<>'
|
||||
f' (span :class "text-emerald-700 text-sm" "Main updated at " "{now}")'
|
||||
f' (div :id "ref-oob-side" :sx-swap-oob "innerHTML"'
|
||||
f' (span :class "text-violet-700 text-sm" "OOB updated at " "{now}")))')
|
||||
oob = _ref_wire("sx-swap-oob", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/select-page")
|
||||
async def ref_select_page():
|
||||
from shared.sx.helpers import sx_response
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = (
|
||||
f'(<>'
|
||||
f' (div :id "the-header" (h3 "Page header — not selected"))'
|
||||
f' (div :id "the-content"'
|
||||
f' (span :class "text-emerald-700 text-sm"'
|
||||
f' "This fragment was selected from a larger response. Time: " "{now}"))'
|
||||
f' (div :id "the-footer" (p "Page footer — not selected")))')
|
||||
oob = _ref_wire("sx-select", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/slow-echo")
|
||||
async def ref_slow_echo():
|
||||
from shared.sx.helpers import sx_response
|
||||
await asyncio.sleep(0.8)
|
||||
q = request.args.get("q", "")
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Echo: " (strong "{q}"))'
|
||||
oob = _ref_wire("sx-sync", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/reference/api/upload-name")
|
||||
async def ref_upload_name():
|
||||
from shared.sx.helpers import sx_response
|
||||
files = await request.files
|
||||
f = files.get("file")
|
||||
name = f.filename if f else "(no file)"
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Received: " (strong "{name}"))'
|
||||
oob = _ref_wire("sx-encoding", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/echo-headers")
|
||||
async def ref_echo_headers():
|
||||
from shared.sx.helpers import sx_response
|
||||
custom = [(k, v) for k, v in request.headers if k.lower().startswith("x-")]
|
||||
if not custom:
|
||||
sx_src = '(span :class "text-stone-400 text-sm" "No custom headers received.")'
|
||||
else:
|
||||
items = " ".join(
|
||||
f'(li (strong "{k}") ": " "{v}")' for k, v in custom)
|
||||
sx_src = f'(ul :class "text-sm text-stone-700 space-y-1" {items})'
|
||||
oob = _ref_wire("sx-headers", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/echo-vals")
|
||||
async def ref_echo_vals_get():
|
||||
from shared.sx.helpers import sx_response
|
||||
vals = list(request.args.items())
|
||||
if not vals:
|
||||
sx_src = '(span :class "text-stone-400 text-sm" "No values received.")'
|
||||
else:
|
||||
items = " ".join(
|
||||
f'(li (strong "{k}") ": " "{v}")' for k, v in vals)
|
||||
sx_src = f'(ul :class "text-sm text-stone-700 space-y-1" {items})'
|
||||
oob_include = _ref_wire("sx-include", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob_include})')
|
||||
|
||||
@csrf_exempt
|
||||
@bp.post("/geography/hypermedia/reference/api/echo-vals")
|
||||
async def ref_echo_vals_post():
|
||||
from shared.sx.helpers import sx_response
|
||||
form = await request.form
|
||||
vals = list(form.items())
|
||||
if not vals:
|
||||
sx_src = '(span :class "text-stone-400 text-sm" "No values received.")'
|
||||
else:
|
||||
items = " ".join(
|
||||
f'(li (strong "{k}") ": " "{v}")' for k, v in vals)
|
||||
sx_src = f'(ul :class "text-sm text-stone-700 space-y-1" {items})'
|
||||
oob = _ref_wire("sx-vals", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
_ref_flaky = {"n": 0}
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/flaky")
|
||||
async def ref_flaky():
|
||||
from shared.sx.helpers import sx_response
|
||||
_ref_flaky["n"] += 1
|
||||
n = _ref_flaky["n"]
|
||||
if n % 3 != 0:
|
||||
return Response("", status=503, content_type="text/plain")
|
||||
sx_src = f'(span :class "text-emerald-700 text-sm" "Success on attempt " "{n}" "!")'
|
||||
oob = _ref_wire("sx-retry", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/prompt-echo")
|
||||
async def ref_prompt_echo():
|
||||
from shared.sx.helpers import sx_response
|
||||
name = request.headers.get("SX-Prompt", "anonymous")
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Hello, " (strong "{name}") "!")'
|
||||
oob = _ref_wire("sx-prompt", sx_src)
|
||||
return sx_response(f'(<> {sx_src} {oob})')
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/sse-time")
|
||||
async def ref_sse_time():
|
||||
async def generate():
|
||||
@@ -1029,30 +162,4 @@ def register(url_prefix: str = "/") -> Blueprint:
|
||||
)
|
||||
return sx_response(sx_src)
|
||||
|
||||
# --- Header demos ---
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/trigger-event")
|
||||
async def ref_trigger_event():
|
||||
from shared.sx.helpers import sx_response
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(span :class "text-stone-800 text-sm" "Loaded at " (strong "{now}") " — check the border!")'
|
||||
resp = sx_response(sx_src)
|
||||
resp.headers["SX-Trigger"] = "showNotice"
|
||||
return resp
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/retarget")
|
||||
async def ref_retarget():
|
||||
from shared.sx.helpers import sx_response
|
||||
now = datetime.now().strftime("%H:%M:%S")
|
||||
sx_src = f'(span :class "text-violet-700 text-sm" "Retargeted at " (strong "{now}"))'
|
||||
resp = sx_response(sx_src)
|
||||
resp.headers["SX-Retarget"] = "#ref-hdr-retarget-alt"
|
||||
return resp
|
||||
|
||||
# --- Event demos ---
|
||||
|
||||
@bp.get("/geography/hypermedia/reference/api/error-500")
|
||||
async def ref_error_500():
|
||||
return Response("Server error", status=500, content_type="text/plain")
|
||||
|
||||
return bp
|
||||
|
||||
@@ -109,3 +109,13 @@
|
||||
:params ()
|
||||
:returns "dict"
|
||||
:service "sx")
|
||||
|
||||
(define-page-helper "spec-explorer-data"
|
||||
:params (filename title desc)
|
||||
:returns "dict"
|
||||
:service "sx")
|
||||
|
||||
(define-page-helper "handler-source"
|
||||
:params (name)
|
||||
:returns "string"
|
||||
:service "sx")
|
||||
|
||||
73
sx/sx/essays/the-art-chain.sx
Normal file
73
sx/sx/essays/the-art-chain.sx
Normal file
@@ -0,0 +1,73 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The Art Chain
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~essay-the-art-chain ()
|
||||
(~doc-page :title "The Art Chain"
|
||||
(p :class "text-stone-500 text-sm italic mb-8"
|
||||
"On making, self-making, and the chain of artifacts that produces itself.")
|
||||
|
||||
(~doc-section :title "I. Ars" :id "ars"
|
||||
(p :class "text-stone-600"
|
||||
"The Latin word " (em "ars") " means something made with skill. Not art as in paintings on gallery walls. Art as in " (em "artifice") ", " (em "artifact") ", " (em "artisan") ". The made thing. The Greek " (em "techne") " is the same word — craft, skill, the knowledge of how to make. There was no distinction between art and engineering because there was no distinction to make.")
|
||||
(p :class "text-stone-600"
|
||||
"A bridge is " (em "ars") ". A poem is " (em "ars") ". A proof is " (em "ars") ". What makes something art is not its medium or its audience but the fact that it was " (em "made") " — brought into being by someone who knew how to bring it into being. The maker's knowledge is embedded in the made thing. You can read the knowledge back out by studying what was made.")
|
||||
(p :class "text-stone-600"
|
||||
"Software is " (em "ars") ". Obviously. It is the most " (em "ars") " thing we have ever built — pure made-ness, structure conjured from nothing, shaped entirely by the maker's skill and intent. There is no raw material. No marble to chisel, no pigment to mix. Just thought, made concrete in symbols."))
|
||||
|
||||
(~doc-section :title "II. The spec at the centre" :id "spec"
|
||||
(p :class "text-stone-600"
|
||||
"SX has a peculiar architecture. At its centre sits a specification — a set of s-expression files that define the language. Not a description of the language. Not documentation " (em "about") " the language. The specification " (em "is") " the language. It is simultaneously a formal definition and executable code. You can read it as a document or run it as a program. It does not describe how to build an SX evaluator; it " (em "is") " an SX evaluator, expressed in the language it defines.")
|
||||
(p :class "text-stone-600"
|
||||
"This is the nucleus. Everything else radiates outward from it.")
|
||||
(~doc-code :code (highlight ";; The spec defines eval-expr\n;; eval-expr evaluates the spec\n;; The spec is an artifact that makes itself\n\n(define eval-expr\n (fn (expr env)\n (cond\n (number? expr) expr\n (string? expr) expr\n (symbol? expr) (env-get env (symbol-name expr))\n (list? expr) (eval-list expr env)\n :else expr)))" "lisp"))
|
||||
(p :class "text-stone-600"
|
||||
"From this nucleus, concentric rings unfurl:"))
|
||||
|
||||
(~doc-section :title "III. The rings" :id "rings"
|
||||
(p :class "text-stone-600"
|
||||
"The first ring is the " (strong "bootstrapper") ". It reads the spec and emits a native implementation — JavaScript, Python, or any other target. The bootstrapper is a translator: it takes the made thing (the spec) and makes another thing (an implementation) that behaves identically. The spec's knowledge is preserved in the translation. Nothing is added, nothing is lost.")
|
||||
(p :class "text-stone-600"
|
||||
"The second ring is the " (strong "platform bridge") ". The spec defines pure logic — evaluation, rendering, parsing. But a running system needs to touch the world: read files, make HTTP requests, manipulate DOM nodes. The platform bridge provides these capabilities. It is the boundary between the made world (the spec) and the found world (the host environment). " (code "boundary.sx") " is literally the membrane — it declares what the host must provide so the spec can function.")
|
||||
(p :class "text-stone-600"
|
||||
"The third ring is the " (strong "runtime") " — bootstrapped spec plus platform bridge, assembled into a working system. This is where the spec stops being an idea and starts being a process. It evaluates expressions. It renders pages. It handles requests.")
|
||||
(p :class "text-stone-600"
|
||||
"The fourth ring is " (strong "application code") " — components, pages, layouts, written in the language the spec defined. Every " (code "defcomp") " is an artifact made from the tools the spec provided. Every " (code "(div :class \"card\" (p \"hello\"))") " is the spec expressing itself through a developer's intent.")
|
||||
(p :class "text-stone-600"
|
||||
"The fifth ring is " (strong "this website") " — which renders the spec's source code using the runtime the spec produced, displayed in components written in the language the spec defines, navigated by an engine the spec specifies. The documentation is the thing documenting itself."))
|
||||
|
||||
(~doc-section :title "IV. The chain" :id "chain"
|
||||
(p :class "text-stone-600"
|
||||
"Each ring is an artifact — a made thing. And each artifact is made " (em "by") " the artifact inside it. The spec makes the bootstrapper's output. The runtime makes the application's output. The application makes the page the user sees. It is a chain of making.")
|
||||
(p :class "text-stone-600"
|
||||
"This chain has three properties that are individually common but collectively rare:")
|
||||
(p :class "text-stone-600"
|
||||
(strong "Content addressing.") " Each artifact can be identified by the hash of its content. The spec at a given version has a specific hash. The bootstrapped output from that spec has a deterministic hash. A component definition has a hash. Identity " (em "is") " content. You don't ask " (em "where") " an artifact lives — you ask " (em "what") " it is.")
|
||||
(p :class "text-stone-600"
|
||||
(strong "Deterministic derivation.") " Given the same spec, the bootstrapper produces the same output. Byte for byte. This is not aspirational — it is verified. The self-hosting bootstrapper (py.sx) proves it: G0 (hand-written bootstrapper) and G1 (self-hosted bootstrapper) produce identical output. The derivation is a pure function. Anyone can run it and verify the result.")
|
||||
(p :class "text-stone-600"
|
||||
(strong "Self-verification.") " The spec includes tools that can prove properties about the spec. " (code "prove.sx") " checks primitive semantics. " (code "types.sx") " validates composition. " (code "z3.sx") " translates declarations into verification conditions. These tools are themselves part of the spec, subject to the same verification they perform. The chain can verify itself.")
|
||||
(p :class "text-stone-600"
|
||||
"These three properties together — content addressing, deterministic derivation, self-verification — are what a blockchain provides. But here there is no proof-of-work, no tokens, no artificial scarcity, no consensus mechanism between untrusted parties. The \"mining\" is bootstrapping. The \"consensus\" is mathematical proof. The \"value\" is that anyone can take the spec, derive an implementation, and " (em "know") " it is correct."))
|
||||
|
||||
(~doc-section :title "V. Universal analysis" :id "analysis"
|
||||
(p :class "text-stone-600"
|
||||
"Here is the consequence that takes time to absorb: any tool that can analyse the spec can analyse " (em "everything the spec produces") ".")
|
||||
(p :class "text-stone-600"
|
||||
"A type checker written in SX that validates the spec's primitives also validates every call to those primitives in every component in every application. A dependency analyser that walks the spec's AST walks application ASTs identically — because application code is expressed in the same structures the spec defines. A theorem prover that verifies the spec's properties verifies the properties of everything downstream.")
|
||||
(p :class "text-stone-600"
|
||||
"This is because the rings are not separate systems. They are the " (em "same") " system at different scales. Application code is spec-shaped. Bootstrapped output is spec-derived. Components are spec-evaluated. The analysis surface is uniform from the nucleus to the outermost ring.")
|
||||
(p :class "text-stone-600"
|
||||
"And the analysis tools are " (em "inside") " the chain. They are artifacts too, written in SX, subject to the same analysis they perform. The type checker can type-check itself. The prover can prove properties about itself. This is not a bug or a curiosity — it is the point. A system that cannot reason about itself is a system that must be reasoned about from outside, by tools written in other languages, maintained by other processes, trusted for other reasons. A self-analysing system closes the loop."))
|
||||
|
||||
(~doc-section :title "VI. The art in the chain" :id "art"
|
||||
(p :class "text-stone-600"
|
||||
"So what is the art chain? It is a chain of artifacts — made things — where each link produces the next, the whole chain can verify itself, and the chain's identity is its content.")
|
||||
(p :class "text-stone-600"
|
||||
"It is not a blockchain in the financial sense. It is not a distributed ledger, a currency, a market. It borrows the structural properties — content addressing, determinism, verification — without the economic machinery. What remains when you strip the economics from a blockchain is a " (em "provenance chain") ": a record of how each thing was made from the thing before it, verifiable by anyone, depending on nothing but the mathematics.")
|
||||
(p :class "text-stone-600"
|
||||
"The Art DAG has the right name. It is not a system for processing \"art\" in the colloquial sense — images, videos, media. It is a " (em "directed acyclic graph of made things") ". Each node is an artifact. Each edge is a derivation. The graph is content-addressed. Execution is deterministic. The DAG itself is the art.")
|
||||
(p :class "text-stone-600"
|
||||
"And the whole SX system — spec, bootstrappers, runtimes, components, pages, this essay explaining itself — is one continuous act of making. " (em "Ars") " all the way down. Not because it is beautiful (though it sometimes is) or expressive (though it tries to be) but because it is " (em "made") ". Deliberately, skilfully, from nothing, by someone who knew how.")
|
||||
(p :class "text-stone-600"
|
||||
"That is what " (em "techne") " always was. We just forgot."))))
|
||||
@@ -9,7 +9,7 @@
|
||||
:demo-description "Click the button to load server-rendered content."
|
||||
:demo (~click-to-load-demo)
|
||||
:sx-code "(button\n :sx-get \"/geography/hypermedia/examples/api/click\"\n :sx-target \"#click-result\"\n :sx-swap \"innerHTML\"\n \"Load content\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/click\")\nasync def api_click():\n now = datetime.now().strftime(...)\n return sx_response(\n f'(~click-result :time \"{now}\")')"
|
||||
:handler-code (handler-source "ex-click")
|
||||
:comp-placeholder-id "click-comp"
|
||||
:wire-placeholder-id "click-wire"
|
||||
:wire-note "The server responds with content-type text/sx. New CSS rules are prepended as a style tag. Clear the component cache to see component definitions included in the wire response."))
|
||||
@@ -21,7 +21,7 @@
|
||||
:demo-description "Enter a name and submit."
|
||||
:demo (~form-demo)
|
||||
:sx-code "(form\n :sx-post \"/geography/hypermedia/examples/api/form\"\n :sx-target \"#form-result\"\n :sx-swap \"innerHTML\"\n (input :type \"text\" :name \"name\")\n (button :type \"submit\" \"Submit\"))"
|
||||
:handler-code "@bp.post(\"/geography/hypermedia/examples/api/form\")\nasync def api_form():\n form = await request.form\n name = form.get(\"name\", \"\")\n return sx_response(\n f'(~form-result :name \"{name}\")')"
|
||||
:handler-code (handler-source "ex-form")
|
||||
:comp-placeholder-id "form-comp"
|
||||
:wire-placeholder-id "form-wire"))
|
||||
|
||||
@@ -32,7 +32,7 @@
|
||||
:demo-description "This div polls the server every 2 seconds."
|
||||
:demo (~polling-demo)
|
||||
:sx-code "(div\n :sx-get \"/geography/hypermedia/examples/api/poll\"\n :sx-trigger \"load, every 2s\"\n :sx-swap \"innerHTML\"\n \"Loading...\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/poll\")\nasync def api_poll():\n poll_count[\"n\"] += 1\n now = datetime.now().strftime(\"%H:%M:%S\")\n count = min(poll_count[\"n\"], 10)\n return sx_response(\n f'(~poll-result :time \"{now}\" :count {count})')"
|
||||
:handler-code (handler-source "ex-poll")
|
||||
:comp-placeholder-id "poll-comp"
|
||||
:wire-placeholder-id "poll-wire"
|
||||
:wire-note "Updates every 2 seconds — watch the time and count change."))
|
||||
@@ -49,7 +49,7 @@
|
||||
(list "4" "Deploy to production")
|
||||
(list "5" "Add unit tests")))
|
||||
:sx-code "(button\n :sx-delete \"/api/delete/1\"\n :sx-target \"#row-1\"\n :sx-swap \"outerHTML\"\n :sx-confirm \"Delete this item?\"\n \"delete\")"
|
||||
:handler-code "@bp.delete(\"/geography/hypermedia/examples/api/delete/<item_id>\")\nasync def api_delete(item_id: str):\n # Empty response — outerHTML swap removes the row\n return Response(\"\", status=200,\n content_type=\"text/sx\")"
|
||||
:handler-code (handler-source "ex-delete")
|
||||
:comp-placeholder-id "delete-comp"
|
||||
:wire-placeholder-id "delete-wire"
|
||||
:wire-note "Empty body — outerHTML swap replaces the target element with nothing."))
|
||||
@@ -61,7 +61,7 @@
|
||||
:demo-description "Click edit, modify the text, save or cancel."
|
||||
:demo (~inline-edit-demo)
|
||||
:sx-code ";; View mode — shows text + edit button\n(~inline-view :value \"some text\")\n\n;; Edit mode — returned by server on click\n(~inline-edit-form :value \"some text\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/edit\")\nasync def api_edit_form():\n value = request.args.get(\"value\", \"\")\n return sx_response(\n f'(~inline-edit-form :value \"{value}\")')\n\n@bp.post(\"/geography/hypermedia/examples/api/edit\")\nasync def api_edit_save():\n form = await request.form\n value = form.get(\"value\", \"\")\n return sx_response(\n f'(~inline-view :value \"{value}\")')"
|
||||
:handler-code (str (handler-source "ex-edit-form") "\n\n" (handler-source "ex-edit-save"))
|
||||
:comp-placeholder-id "edit-comp"
|
||||
:comp-heading "Components"
|
||||
:handler-heading "Server handlers"
|
||||
@@ -74,7 +74,7 @@
|
||||
:demo-description "One request updates both Box A (via sx-target) and Box B (via sx-swap-oob)."
|
||||
:demo (~oob-demo)
|
||||
:sx-code ";; Button targets Box A\n(button\n :sx-get \"/geography/hypermedia/examples/api/oob\"\n :sx-target \"#oob-box-a\"\n :sx-swap \"innerHTML\"\n \"Update both boxes\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/oob\")\nasync def api_oob():\n now = datetime.now().strftime(\"%H:%M:%S\")\n return sx_response(\n f'(<>'\n f' (p \"Box A updated at {now}\")'\n f' (div :id \"oob-box-b\"'\n f' :sx-swap-oob \"innerHTML\"'\n f' (p \"Box B updated at {now}\")))')"
|
||||
:handler-code (handler-source "ex-oob")
|
||||
:wire-placeholder-id "oob-wire"
|
||||
:wire-note "The fragment contains both the main content and an OOB element. sx.js splits them: main content goes to sx-target, OOB elements find their targets by ID."))
|
||||
|
||||
@@ -85,7 +85,7 @@
|
||||
:demo-description "Content loads automatically when the page renders."
|
||||
:demo (~lazy-loading-demo)
|
||||
:sx-code "(div\n :sx-get \"/geography/hypermedia/examples/api/lazy\"\n :sx-trigger \"load\"\n :sx-swap \"innerHTML\"\n (div :class \"animate-pulse\" \"Loading...\"))"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/lazy\")\nasync def api_lazy():\n now = datetime.now().strftime(...)\n return sx_response(\n f'(~lazy-result :time \"{now}\")')"
|
||||
:handler-code (handler-source "ex-lazy")
|
||||
:comp-placeholder-id "lazy-comp"
|
||||
:wire-placeholder-id "lazy-wire"))
|
||||
|
||||
@@ -96,7 +96,7 @@
|
||||
:demo-description "Scroll down in the container to load more items (5 pages total)."
|
||||
:demo (~infinite-scroll-demo)
|
||||
:sx-code "(div :id \"scroll-sentinel\"\n :sx-get \"/geography/hypermedia/examples/api/scroll?page=2\"\n :sx-trigger \"intersect once\"\n :sx-target \"#scroll-items\"\n :sx-swap \"beforeend\"\n \"Loading more...\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/scroll\")\nasync def api_scroll():\n page = int(request.args.get(\"page\", 2))\n items = [f\"Item {i}\" for i in range(...)]\n # Include next sentinel if more pages\n return sx_response(items_sx + sentinel_sx)"
|
||||
:handler-code (handler-source "ex-scroll")
|
||||
:comp-placeholder-id "scroll-comp"
|
||||
:wire-placeholder-id "scroll-wire"))
|
||||
|
||||
@@ -107,7 +107,7 @@
|
||||
:demo-description "Click start to begin a simulated job."
|
||||
:demo (~progress-bar-demo)
|
||||
:sx-code ";; Start the job\n(button\n :sx-post \"/geography/hypermedia/examples/api/progress/start\"\n :sx-target \"#progress-target\"\n :sx-swap \"innerHTML\")\n\n;; Each response re-polls via sx-trigger=\"load\"\n(div :sx-get \"/api/progress/status?job=ID\"\n :sx-trigger \"load delay:500ms\"\n :sx-target \"#progress-target\"\n :sx-swap \"innerHTML\")"
|
||||
:handler-code "@bp.post(\"/geography/hypermedia/examples/api/progress/start\")\nasync def api_progress_start():\n job_id = str(uuid4())[:8]\n _jobs[job_id] = 0\n return sx_response(\n f'(~progress-status :percent 0 :job-id \"{job_id}\")')"
|
||||
:handler-code (str (handler-source "ex-progress-start") "\n\n" (handler-source "ex-progress-status"))
|
||||
:comp-placeholder-id "progress-comp"
|
||||
:wire-placeholder-id "progress-wire"))
|
||||
|
||||
@@ -118,7 +118,7 @@
|
||||
:demo-description "Type to search through 20 programming languages."
|
||||
:demo (~active-search-demo)
|
||||
:sx-code "(input :type \"text\" :name \"q\"\n :sx-get \"/geography/hypermedia/examples/api/search\"\n :sx-trigger \"keyup delay:300ms changed\"\n :sx-target \"#search-results\"\n :sx-swap \"innerHTML\"\n :placeholder \"Search...\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/search\")\nasync def api_search():\n q = request.args.get(\"q\", \"\").lower()\n results = [l for l in LANGUAGES if q in l.lower()]\n return sx_response(\n f'(~search-results :items (...) :query \"{q}\")')"
|
||||
:handler-code (handler-source "ex-search")
|
||||
:comp-placeholder-id "search-comp"
|
||||
:wire-placeholder-id "search-wire"))
|
||||
|
||||
@@ -129,7 +129,7 @@
|
||||
:demo-description "Enter an email and click away (blur) to validate."
|
||||
:demo (~inline-validation-demo)
|
||||
:sx-code "(input :type \"text\" :name \"email\"\n :sx-get \"/geography/hypermedia/examples/api/validate\"\n :sx-trigger \"blur\"\n :sx-target \"#email-feedback\"\n :sx-swap \"innerHTML\"\n :placeholder \"user@example.com\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/validate\")\nasync def api_validate():\n email = request.args.get(\"email\", \"\")\n if \"@\" not in email:\n return sx_response('(~validation-error ...)')\n return sx_response('(~validation-ok ...)')"
|
||||
:handler-code (handler-source "ex-validate")
|
||||
:comp-placeholder-id "validate-comp"
|
||||
:wire-placeholder-id "validate-wire"))
|
||||
|
||||
@@ -140,7 +140,7 @@
|
||||
:demo-description "Select a category to populate the item dropdown."
|
||||
:demo (~value-select-demo)
|
||||
:sx-code "(select :name \"category\"\n :sx-get \"/geography/hypermedia/examples/api/values\"\n :sx-trigger \"change\"\n :sx-target \"#value-items\"\n :sx-swap \"innerHTML\"\n (option \"Languages\")\n (option \"Frameworks\")\n (option \"Databases\"))"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/values\")\nasync def api_values():\n cat = request.args.get(\"category\", \"\")\n items = VALUE_SELECT_DATA.get(cat, [])\n return sx_response(\n f'(~value-options :items (list ...))')"
|
||||
:handler-code (handler-source "ex-values")
|
||||
:comp-placeholder-id "values-comp"
|
||||
:wire-placeholder-id "values-wire"))
|
||||
|
||||
@@ -151,7 +151,7 @@
|
||||
:demo-description "Submit a message — the input resets after each send."
|
||||
:demo (~reset-on-submit-demo)
|
||||
:sx-code "(form :id \"reset-form\"\n :sx-post \"/geography/hypermedia/examples/api/reset-submit\"\n :sx-target \"#reset-result\"\n :sx-swap \"innerHTML\"\n :sx-on:afterSwap \"this.reset()\"\n (input :type \"text\" :name \"message\")\n (button :type \"submit\" \"Send\"))"
|
||||
:handler-code "@bp.post(\"/geography/hypermedia/examples/api/reset-submit\")\nasync def api_reset_submit():\n form = await request.form\n msg = form.get(\"message\", \"\")\n return sx_response(\n f'(~reset-message :message \"{msg}\" :time \"...\")')"
|
||||
:handler-code (handler-source "ex-reset-submit")
|
||||
:comp-placeholder-id "reset-comp"
|
||||
:wire-placeholder-id "reset-wire"))
|
||||
|
||||
@@ -166,7 +166,7 @@
|
||||
(list "3" "Widget C" "12.00" "305")
|
||||
(list "4" "Widget D" "45.00" "67")))
|
||||
:sx-code "(button\n :sx-get \"/geography/hypermedia/examples/api/editrow/1\"\n :sx-target \"#erow-1\"\n :sx-swap \"outerHTML\"\n \"edit\")\n\n;; Save sends form data via POST\n(button\n :sx-post \"/geography/hypermedia/examples/api/editrow/1\"\n :sx-target \"#erow-1\"\n :sx-swap \"outerHTML\"\n :sx-include \"#erow-1\"\n \"save\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/editrow/<id>\")\nasync def api_editrow_form(id):\n row = EDIT_ROW_DATA[id]\n return sx_response(\n f'(~edit-row-form :id ... :name ...)')\n\n@bp.post(\"/geography/hypermedia/examples/api/editrow/<id>\")\nasync def api_editrow_save(id):\n form = await request.form\n return sx_response(\n f'(~edit-row-view :id ... :name ...)')"
|
||||
:handler-code (str (handler-source "ex-editrow-form") "\n\n" (handler-source "ex-editrow-save"))
|
||||
:comp-placeholder-id "editrow-comp"
|
||||
:wire-placeholder-id "editrow-wire"))
|
||||
|
||||
@@ -182,7 +182,7 @@
|
||||
(list "4" "Dan Okafor" "dan@example.com" "inactive")
|
||||
(list "5" "Eve Larsson" "eve@example.com" "active")))
|
||||
:sx-code "(button\n :sx-post \"/geography/hypermedia/examples/api/bulk?action=activate\"\n :sx-target \"#bulk-table\"\n :sx-swap \"innerHTML\"\n :sx-include \"#bulk-form\"\n \"Activate\")"
|
||||
:handler-code "@bp.post(\"/geography/hypermedia/examples/api/bulk\")\nasync def api_bulk():\n action = request.args.get(\"action\")\n form = await request.form\n ids = form.getlist(\"ids\")\n # Update matching users\n return sx_response(updated_rows)"
|
||||
:handler-code (handler-source "ex-bulk")
|
||||
:comp-placeholder-id "bulk-comp"
|
||||
:wire-placeholder-id "bulk-wire"))
|
||||
|
||||
@@ -193,7 +193,7 @@
|
||||
:demo-description "Try each button to see different swap behaviours."
|
||||
:demo (~swap-positions-demo)
|
||||
:sx-code ";; Append to end\n(button :sx-post \"/api/swap-log?mode=beforeend\"\n :sx-target \"#swap-log\" :sx-swap \"beforeend\"\n \"Add to End\")\n\n;; Prepend to start\n(button :sx-post \"/api/swap-log?mode=afterbegin\"\n :sx-target \"#swap-log\" :sx-swap \"afterbegin\"\n \"Add to Start\")\n\n;; No swap — OOB counter update only\n(button :sx-post \"/api/swap-log?mode=none\"\n :sx-target \"#swap-log\" :sx-swap \"none\"\n \"Silent Ping\")"
|
||||
:handler-code "@bp.post(\"/geography/hypermedia/examples/api/swap-log\")\nasync def api_swap_log():\n mode = request.args.get(\"mode\")\n # OOB counter updates on every request\n oob = f'(span :id \"swap-counter\" :sx-swap-oob \"innerHTML\" \"Count: {n}\")'\n return sx_response(entry + oob)"
|
||||
:handler-code (handler-source "ex-swap-log")
|
||||
:wire-placeholder-id "swap-wire"))
|
||||
|
||||
(defcomp ~example-select-filter ()
|
||||
@@ -203,7 +203,7 @@
|
||||
:demo-description "Different buttons select different parts of the same server response."
|
||||
:demo (~select-filter-demo)
|
||||
:sx-code ";; Pick just the stats section from the response\n(button\n :sx-get \"/geography/hypermedia/examples/api/dashboard\"\n :sx-target \"#filter-target\"\n :sx-swap \"innerHTML\"\n :sx-select \"#dash-stats\"\n \"Stats Only\")\n\n;; No sx-select — get the full response\n(button\n :sx-get \"/geography/hypermedia/examples/api/dashboard\"\n :sx-target \"#filter-target\"\n :sx-swap \"innerHTML\"\n \"Full Dashboard\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/dashboard\")\nasync def api_dashboard():\n # Returns header + stats + footer\n # Client uses sx-select to pick sections\n return sx_response(\n '(<> (div :id \"dash-header\" ...) '\n ' (div :id \"dash-stats\" ...) '\n ' (div :id \"dash-footer\" ...))')"
|
||||
:handler-code (handler-source "ex-dashboard")
|
||||
:wire-placeholder-id "filter-wire"))
|
||||
|
||||
(defcomp ~example-tabs ()
|
||||
@@ -213,7 +213,7 @@
|
||||
:demo-description "Click tabs to switch content. Watch the browser URL change."
|
||||
:demo (~tabs-demo)
|
||||
:sx-code "(button\n :sx-get \"/geography/hypermedia/examples/api/tabs/tab1\"\n :sx-target \"#tab-content\"\n :sx-swap \"innerHTML\"\n :sx-push-url \"/geography/hypermedia/examples/tabs?tab=tab1\"\n \"Overview\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/tabs/<tab>\")\nasync def api_tabs(tab: str):\n content = TAB_CONTENT[tab]\n return sx_response(content)"
|
||||
:handler-code (handler-source "ex-tabs")
|
||||
:wire-placeholder-id "tabs-wire"))
|
||||
|
||||
(defcomp ~example-animations ()
|
||||
@@ -223,7 +223,7 @@
|
||||
:demo-description "Click to swap in content with a fade-in animation."
|
||||
:demo (~animations-demo)
|
||||
:sx-code "(button\n :sx-get \"/geography/hypermedia/examples/api/animate\"\n :sx-target \"#anim-target\"\n :sx-swap \"innerHTML\"\n \"Load with animation\")\n\n;; Component uses CSS animation class\n(defcomp ~anim-result (&key color time)\n (div :class \"sx-fade-in ...\"\n (style \".sx-fade-in { animation: sxFadeIn 0.5s }\")\n (p \"Faded in!\")))"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/animate\")\nasync def api_animate():\n colors = [\"bg-violet-100\", \"bg-emerald-100\", ...]\n color = random.choice(colors)\n return sx_response(\n f'(~anim-result :color \"{color}\" :time \"{now}\")')"
|
||||
:handler-code (handler-source "ex-animate")
|
||||
:comp-placeholder-id "anim-comp"
|
||||
:wire-placeholder-id "anim-wire"))
|
||||
|
||||
@@ -234,7 +234,7 @@
|
||||
:demo-description "Click to open a modal dialog."
|
||||
:demo (~dialogs-demo)
|
||||
:sx-code "(button\n :sx-get \"/geography/hypermedia/examples/api/dialog\"\n :sx-target \"#dialog-container\"\n :sx-swap \"innerHTML\"\n \"Open Dialog\")\n\n;; Dialog closes by swapping empty content\n(button\n :sx-get \"/geography/hypermedia/examples/api/dialog/close\"\n :sx-target \"#dialog-container\"\n :sx-swap \"innerHTML\"\n \"Close\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/dialog\")\nasync def api_dialog():\n return sx_response(\n '(~dialog-modal :title \"Confirm\"'\n ' :message \"Are you sure?\")')\n\n@bp.get(\"/geography/hypermedia/examples/api/dialog/close\")\nasync def api_dialog_close():\n return sx_response(\"\")"
|
||||
:handler-code (str (handler-source "ex-dialog") "\n\n" (handler-source "ex-dialog-close"))
|
||||
:comp-placeholder-id "dialog-comp"
|
||||
:wire-placeholder-id "dialog-wire"))
|
||||
|
||||
@@ -245,7 +245,7 @@
|
||||
:demo-description "Press s, n, or h on your keyboard."
|
||||
:demo (~keyboard-shortcuts-demo)
|
||||
:sx-code "(div :id \"kbd-target\"\n :sx-get \"/geography/hypermedia/examples/api/keyboard?key=s\"\n :sx-trigger \"keyup[key=='s'&&!event.target.matches('input,textarea')] from:body\"\n :sx-swap \"innerHTML\"\n \"Press a shortcut key...\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/keyboard\")\nasync def api_keyboard():\n key = request.args.get(\"key\", \"\")\n actions = {\"s\": \"Search\", \"n\": \"New item\", \"h\": \"Help\"}\n return sx_response(\n f'(~kbd-result :key \"{key}\" :action \"{actions[key]}\")')"
|
||||
:handler-code (handler-source "ex-keyboard")
|
||||
:comp-placeholder-id "kbd-comp"
|
||||
:wire-placeholder-id "kbd-wire"))
|
||||
|
||||
@@ -256,7 +256,7 @@
|
||||
:demo-description "Click Edit All to replace the full profile via PUT."
|
||||
:demo (~put-patch-demo :name "Ada Lovelace" :email "ada@example.com" :role "Engineer")
|
||||
:sx-code ";; Replace entire resource\n(form :sx-put \"/geography/hypermedia/examples/api/putpatch\"\n :sx-target \"#pp-target\" :sx-swap \"innerHTML\"\n (input :name \"name\") (input :name \"email\")\n (button \"Save All (PUT)\"))"
|
||||
:handler-code "@bp.put(\"/geography/hypermedia/examples/api/putpatch\")\nasync def api_put():\n form = await request.form\n # Full replacement\n return sx_response('(~pp-view ...)')"
|
||||
:handler-code (str (handler-source "ex-pp-edit-all") "\n\n" (handler-source "ex-pp-put"))
|
||||
:comp-placeholder-id "pp-comp"
|
||||
:wire-placeholder-id "pp-wire"))
|
||||
|
||||
@@ -267,7 +267,7 @@
|
||||
:demo-description "Submit the form and see the JSON body the server received."
|
||||
:demo (~json-encoding-demo)
|
||||
:sx-code "(form\n :sx-post \"/geography/hypermedia/examples/api/json-echo\"\n :sx-target \"#json-result\"\n :sx-swap \"innerHTML\"\n :sx-encoding \"json\"\n (input :name \"name\" :value \"Ada\")\n (input :type \"number\" :name \"age\" :value \"36\")\n (button \"Submit as JSON\"))"
|
||||
:handler-code "@bp.post(\"/geography/hypermedia/examples/api/json-echo\")\nasync def api_json_echo():\n data = await request.get_json()\n body = json.dumps(data, indent=2)\n ct = request.content_type\n return sx_response(\n f'(~json-result :body \"{body}\" :content-type \"{ct}\")')"
|
||||
:handler-code (handler-source "ex-json-echo")
|
||||
:comp-placeholder-id "json-comp"
|
||||
:wire-placeholder-id "json-wire"))
|
||||
|
||||
@@ -278,7 +278,7 @@
|
||||
:demo-description "Click each button to see what the server receives."
|
||||
:demo (~vals-headers-demo)
|
||||
:sx-code ";; Send extra values with the request\n(button\n :sx-get \"/geography/hypermedia/examples/api/echo-vals\"\n :sx-vals \"{\\\"source\\\": \\\"button\\\"}\"\n \"Send with vals\")\n\n;; Send custom headers\n(button\n :sx-get \"/geography/hypermedia/examples/api/echo-headers\"\n :sx-headers {:X-Custom-Token \"abc123\"}\n \"Send with headers\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/echo-vals\")\nasync def api_echo_vals():\n vals = dict(request.args)\n return sx_response(\n f'(~echo-result :label \"values\" :items (...))')\n\n@bp.get(\"/geography/hypermedia/examples/api/echo-headers\")\nasync def api_echo_headers():\n custom = {k: v for k, v in request.headers\n if k.startswith(\"X-\")}\n return sx_response(\n f'(~echo-result :label \"headers\" :items (...))')"
|
||||
:handler-code (str (handler-source "ex-echo-vals") "\n\n" (handler-source "ex-echo-headers"))
|
||||
:comp-placeholder-id "vals-comp"
|
||||
:wire-placeholder-id "vals-wire"))
|
||||
|
||||
@@ -289,7 +289,7 @@
|
||||
:demo-description "Click the button — it shows a spinner during the 2-second request."
|
||||
:demo (~loading-states-demo)
|
||||
:sx-code ";; .sx-request class added during request\n(style \".sx-loading-btn.sx-request {\n opacity: 0.7; pointer-events: none; }\n.sx-loading-btn.sx-request .sx-spinner {\n display: inline-block; }\n.sx-loading-btn .sx-spinner {\n display: none; }\")\n\n(button :class \"sx-loading-btn\"\n :sx-get \"/geography/hypermedia/examples/api/slow\"\n :sx-target \"#loading-result\"\n (span :class \"sx-spinner animate-spin\" \"...\")\n \"Load slow endpoint\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/slow\")\nasync def api_slow():\n await asyncio.sleep(2)\n return sx_response(\n f'(~loading-result :time \"{now}\")')"
|
||||
:handler-code (handler-source "ex-slow")
|
||||
:comp-placeholder-id "loading-comp"
|
||||
:wire-placeholder-id "loading-wire"))
|
||||
|
||||
@@ -300,7 +300,7 @@
|
||||
:demo-description "Type quickly — only the latest result appears despite random 0.5-2s server delays."
|
||||
:demo (~sync-replace-demo)
|
||||
:sx-code "(input :type \"text\" :name \"q\"\n :sx-get \"/geography/hypermedia/examples/api/slow-search\"\n :sx-trigger \"keyup delay:200ms changed\"\n :sx-target \"#sync-result\"\n :sx-swap \"innerHTML\"\n :sx-sync \"replace\"\n \"Type to search...\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/slow-search\")\nasync def api_slow_search():\n delay = random.uniform(0.5, 2.0)\n await asyncio.sleep(delay)\n q = request.args.get(\"q\", \"\")\n return sx_response(\n f'(~sync-result :query \"{q}\" :delay \"{delay_ms}\")')"
|
||||
:handler-code (handler-source "ex-slow-search")
|
||||
:comp-placeholder-id "sync-comp"
|
||||
:wire-placeholder-id "sync-wire"))
|
||||
|
||||
@@ -311,6 +311,6 @@
|
||||
:demo-description "Click the button — watch it retry automatically after failures."
|
||||
:demo (~retry-demo)
|
||||
:sx-code "(button\n :sx-get \"/geography/hypermedia/examples/api/flaky\"\n :sx-target \"#retry-result\"\n :sx-swap \"innerHTML\"\n :sx-retry \"exponential:1000:8000\"\n \"Call flaky endpoint\")"
|
||||
:handler-code "@bp.get(\"/geography/hypermedia/examples/api/flaky\")\nasync def api_flaky():\n _flaky[\"n\"] += 1\n if _flaky[\"n\"] % 3 != 0:\n return Response(\"\", status=503)\n return sx_response(\n f'(~retry-result :attempt {n} ...)')"
|
||||
:handler-code (handler-source "ex-flaky")
|
||||
:comp-placeholder-id "retry-comp"
|
||||
:wire-placeholder-id "retry-wire"))
|
||||
|
||||
782
sx/sx/handlers/examples.sx
Normal file
782
sx/sx/handlers/examples.sx
Normal file
@@ -0,0 +1,782 @@
|
||||
;; ==========================================================================
|
||||
;; Example API endpoints — live demos for hypermedia examples pages
|
||||
;;
|
||||
;; Each defhandler with :path registers as a public route automatically.
|
||||
;; OOB swaps show wire format and component source alongside each demo.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Data constants (captured in handler closures)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define search-languages
|
||||
(list "Python" "JavaScript" "TypeScript" "Rust" "Go" "Java" "C" "C++"
|
||||
"Ruby" "Elixir" "Haskell" "Clojure" "Scala" "Kotlin" "Swift"
|
||||
"Zig" "OCaml" "Lua" "Perl" "PHP"))
|
||||
|
||||
(define value-select-data
|
||||
{"Languages" (list "Python" "JavaScript" "Rust" "Go")
|
||||
"Frameworks" (list "Quart" "FastAPI" "React" "Svelte")
|
||||
"Databases" (list "PostgreSQL" "Redis" "SQLite" "MongoDB")})
|
||||
|
||||
(define taken-emails
|
||||
(list "admin@example.com" "test@example.com" "user@example.com"))
|
||||
|
||||
(define tab-content
|
||||
{"tab1" "Welcome to the Overview tab. This is the default tab content loaded via sx-get."
|
||||
"tab2" "Here are the details. Version: 1.0.0, Build: 2024-01-15, Engine: sx"
|
||||
"tab3" "Recent history: Initial release, Added component caching, Wire format v2"})
|
||||
|
||||
(define kbd-actions
|
||||
{"s" "Search panel activated"
|
||||
"n" "New item created"
|
||||
"h" "Help panel opened"})
|
||||
|
||||
(define anim-colors
|
||||
(list "bg-violet-100" "bg-emerald-100" "bg-blue-100" "bg-amber-100" "bg-rose-100"))
|
||||
|
||||
(define edit-row-defaults
|
||||
{"1" {"id" "1" "name" "Widget A" "price" "19.99" "stock" "142"}
|
||||
"2" {"id" "2" "name" "Widget B" "price" "24.50" "stock" "89"}
|
||||
"3" {"id" "3" "name" "Widget C" "price" "12.00" "stock" "305"}
|
||||
"4" {"id" "4" "name" "Widget D" "price" "45.00" "stock" "67"}})
|
||||
|
||||
(define bulk-user-defaults
|
||||
{"1" {"id" "1" "name" "Alice Chen" "email" "alice@example.com" "status" "active"}
|
||||
"2" {"id" "2" "name" "Bob Rivera" "email" "bob@example.com" "status" "inactive"}
|
||||
"3" {"id" "3" "name" "Carol Zhang" "email" "carol@example.com" "status" "active"}
|
||||
"4" {"id" "4" "name" "Dan Okafor" "email" "dan@example.com" "status" "inactive"}
|
||||
"5" {"id" "5" "name" "Eve Larsson" "email" "eve@example.com" "status" "active"}})
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Click to Load
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-click
|
||||
:path "/geography/hypermedia/examples/api/click"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%Y-%m-%d %H:%M:%S")))
|
||||
(<>
|
||||
(~click-result :time now)
|
||||
(~doc-oob-code :target-id "click-comp"
|
||||
:text (component-source "click-result"))
|
||||
(~doc-oob-code :target-id "click-wire"
|
||||
:text (str "(~click-result :time \"" now "\")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Form Submission
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-form
|
||||
:path "/geography/hypermedia/examples/api/form"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((name (request-form "name" "")))
|
||||
(<>
|
||||
(~form-result :name name)
|
||||
(~doc-oob-code :target-id "form-comp"
|
||||
:text (component-source "form-result"))
|
||||
(~doc-oob-code :target-id "form-wire"
|
||||
:text (str "(~form-result :name \"" name "\")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Polling
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-poll
|
||||
:path "/geography/hypermedia/examples/api/poll"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((n (+ (state-get "ex-poll-n" 0) 1)))
|
||||
(state-set! "ex-poll-n" n)
|
||||
(let ((now (now "%H:%M:%S"))
|
||||
(count (if (< n 10) n 10)))
|
||||
(<>
|
||||
(~poll-result :time now :count count)
|
||||
(~doc-oob-code :target-id "poll-comp"
|
||||
:text (component-source "poll-result"))
|
||||
(~doc-oob-code :target-id "poll-wire"
|
||||
:text (str "(~poll-result :time \"" now "\" :count " count ")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Delete Row
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-delete
|
||||
:path "/geography/hypermedia/examples/api/delete/<item_id>"
|
||||
:method :delete
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key item-id)
|
||||
(<>
|
||||
(~doc-oob-code :target-id "delete-comp"
|
||||
:text (component-source "delete-row"))
|
||||
(~doc-oob-code :target-id "delete-wire"
|
||||
:text "(empty — row removed by outerHTML swap)")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Inline Edit
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-edit-form
|
||||
:path "/geography/hypermedia/examples/api/edit"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((value (request-arg "value" "")))
|
||||
(<>
|
||||
(~inline-edit-form :value value)
|
||||
(~doc-oob-code :target-id "edit-comp"
|
||||
:text (component-source "inline-edit-form"))
|
||||
(~doc-oob-code :target-id "edit-wire"
|
||||
:text (str "(~inline-edit-form :value \"" value "\")")))))
|
||||
|
||||
(defhandler ex-edit-save
|
||||
:path "/geography/hypermedia/examples/api/edit"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((value (request-form "value" "")))
|
||||
(<>
|
||||
(~inline-view :value value)
|
||||
(~doc-oob-code :target-id "edit-comp"
|
||||
:text (component-source "inline-view"))
|
||||
(~doc-oob-code :target-id "edit-wire"
|
||||
:text (str "(~inline-view :value \"" value "\")")))))
|
||||
|
||||
(defhandler ex-edit-cancel
|
||||
:path "/geography/hypermedia/examples/api/edit/cancel"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((value (request-arg "value" "")))
|
||||
(<>
|
||||
(~inline-view :value value)
|
||||
(~doc-oob-code :target-id "edit-comp"
|
||||
:text (component-source "inline-view"))
|
||||
(~doc-oob-code :target-id "edit-wire"
|
||||
:text (str "(~inline-view :value \"" value "\")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Out-of-Band Swaps
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-oob
|
||||
:path "/geography/hypermedia/examples/api/oob"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(p :class "text-emerald-600 font-medium" "Box A updated!")
|
||||
(p :class "text-sm text-stone-500" (str "at " now))
|
||||
(div :id "oob-box-b" :sx-swap-oob "innerHTML"
|
||||
(p :class "text-violet-600 font-medium" "Box B updated via OOB!")
|
||||
(p :class "text-sm text-stone-500" (str "at " now)))
|
||||
(~doc-oob-code :target-id "oob-wire"
|
||||
:text (str "(<> (p ... \"Box A updated!\") (div :id \"oob-box-b\" :sx-swap-oob \"innerHTML\" (p ... \"Box B updated!\")))")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Lazy Loading
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-lazy
|
||||
:path "/geography/hypermedia/examples/api/lazy"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(~lazy-result :time now)
|
||||
(~doc-oob-code :target-id "lazy-comp"
|
||||
:text (component-source "lazy-result"))
|
||||
(~doc-oob-code :target-id "lazy-wire"
|
||||
:text (str "(~lazy-result :time \"" now "\")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Infinite Scroll
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-scroll
|
||||
:path "/geography/hypermedia/examples/api/scroll"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((page (request-arg "page" "2")))
|
||||
(let ((pg (parse-int page))
|
||||
(start (+ (* (- (parse-int page) 1) 5) 1)))
|
||||
(<>
|
||||
(map (fn (i)
|
||||
(div :class "px-4 py-3 border-b border-stone-100 text-sm text-stone-700"
|
||||
(str "Item " i " — loaded from page " page)))
|
||||
(range start (+ start 5)))
|
||||
(if (<= (+ pg 1) 6)
|
||||
(div :id "scroll-sentinel"
|
||||
:sx-get (str "/geography/hypermedia/examples/api/scroll?page=" (+ pg 1))
|
||||
:sx-trigger "intersect once"
|
||||
:sx-target "#scroll-items"
|
||||
:sx-swap "beforeend"
|
||||
:class "p-3 text-center text-stone-400 text-sm"
|
||||
"Loading more...")
|
||||
(div :class "p-3 text-center text-stone-500 text-sm font-medium"
|
||||
"All items loaded."))
|
||||
(~doc-oob-code :target-id "scroll-wire"
|
||||
:text (str "(items for page " page " + sentinel)"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Progress Bar
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-progress-start
|
||||
:path "/geography/hypermedia/examples/api/progress/start"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((n (+ (state-get "ex-job-counter" 0) 1)))
|
||||
(state-set! "ex-job-counter" n)
|
||||
(let ((job-id (str "job-" n)))
|
||||
(state-set! (str "ex-job-" job-id) 0)
|
||||
(<>
|
||||
(~progress-status :percent 0 :job-id job-id)
|
||||
(~doc-oob-code :target-id "progress-comp"
|
||||
:text (component-source "progress-status"))
|
||||
(~doc-oob-code :target-id "progress-wire"
|
||||
:text (str "(~progress-status :percent 0 :job-id \"" job-id "\")"))))))
|
||||
|
||||
(defhandler ex-progress-status
|
||||
:path "/geography/hypermedia/examples/api/progress/status"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((job-id (request-arg "job" "")))
|
||||
(let ((current (state-get (str "ex-job-" job-id) 0)))
|
||||
(let ((next (if (>= (+ current (random-int 15 30)) 100) 100 (+ current (random-int 15 30)))))
|
||||
(state-set! (str "ex-job-" job-id) next)
|
||||
(<>
|
||||
(~progress-status :percent next :job-id job-id)
|
||||
(~doc-oob-code :target-id "progress-comp"
|
||||
:text (component-source "progress-status"))
|
||||
(~doc-oob-code :target-id "progress-wire"
|
||||
:text (str "(~progress-status :percent " next " :job-id \"" job-id "\")")))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Active Search
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-search
|
||||
:path "/geography/hypermedia/examples/api/search"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((q (request-arg "q" "")))
|
||||
(let ((results (if (= q "")
|
||||
search-languages
|
||||
(filter (fn (lang) (contains? (lower-case lang) (lower-case q)))
|
||||
search-languages))))
|
||||
(<>
|
||||
(~search-results :items results :query q)
|
||||
(~doc-oob-code :target-id "search-comp"
|
||||
:text (component-source "search-results"))
|
||||
(~doc-oob-code :target-id "search-wire"
|
||||
:text (str "(~search-results :items (list ...) :query \"" q "\")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Inline Validation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-validate
|
||||
:path "/geography/hypermedia/examples/api/validate"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((email (request-arg "email" "")))
|
||||
(let ((result
|
||||
(cond
|
||||
(= email "")
|
||||
(list "validation-error" "(~validation-error :message \"Email is required\")"
|
||||
(~validation-error :message "Email is required"))
|
||||
(not (contains? email "@"))
|
||||
(list "validation-error" "(~validation-error :message \"Invalid email format\")"
|
||||
(~validation-error :message "Invalid email format"))
|
||||
(some (fn (e) (= (lower-case e) (lower-case email))) taken-emails)
|
||||
(list "validation-error" (str "(~validation-error :message \"" email " is already taken\")")
|
||||
(~validation-error :message (str email " is already taken")))
|
||||
:else
|
||||
(list "validation-ok" (str "(~validation-ok :email \"" email "\")")
|
||||
(~validation-ok :email email)))))
|
||||
(<>
|
||||
(nth result 2)
|
||||
(~doc-oob-code :target-id "validate-comp"
|
||||
:text (component-source (first result)))
|
||||
(~doc-oob-code :target-id "validate-wire"
|
||||
:text (nth result 1))))))
|
||||
|
||||
(defhandler ex-validate-submit
|
||||
:path "/geography/hypermedia/examples/api/validate/submit"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((email (request-form "email" "")))
|
||||
(if (or (= email "") (not (contains? email "@")))
|
||||
(p :class "text-sm text-rose-600 mt-2" "Please enter a valid email.")
|
||||
(p :class "text-sm text-emerald-600 mt-2" (str "Form submitted with: " email)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Value Select
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-values
|
||||
:path "/geography/hypermedia/examples/api/values"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((cat (request-arg "category" "")))
|
||||
(let ((items (get value-select-data cat (list))))
|
||||
(let ((options (if (empty? items)
|
||||
(list (option :value "" "No items"))
|
||||
(map (fn (i) (option :value i i)) items))))
|
||||
(<>
|
||||
options
|
||||
(~doc-oob-code :target-id "values-wire"
|
||||
:text (str "(options for \"" cat "\")")))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Reset on Submit
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-reset-submit
|
||||
:path "/geography/hypermedia/examples/api/reset-submit"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((msg (request-form "message" "(empty)"))
|
||||
(now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(~reset-message :message msg :time now)
|
||||
(~doc-oob-code :target-id "reset-comp"
|
||||
:text (component-source "reset-message"))
|
||||
(~doc-oob-code :target-id "reset-wire"
|
||||
:text (str "(~reset-message :message \"" msg "\" :time \"" now "\")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Edit Row
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-editrow-form
|
||||
:path "/geography/hypermedia/examples/api/editrow/<row_id>"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key row-id)
|
||||
(let ((default (get edit-row-defaults row-id {"id" row-id "name" "" "price" "0" "stock" "0"})))
|
||||
(let ((row (state-get (str "ex-row-" row-id) default)))
|
||||
(<>
|
||||
(~edit-row-form :id (get row "id") :name (get row "name")
|
||||
:price (get row "price") :stock (get row "stock"))
|
||||
(~doc-oob-code :target-id "editrow-comp"
|
||||
:text (component-source "edit-row-form"))
|
||||
(~doc-oob-code :target-id "editrow-wire"
|
||||
:text (str "(~edit-row-form :id \"" (get row "id") "\" ...)"))))))
|
||||
|
||||
(defhandler ex-editrow-save
|
||||
:path "/geography/hypermedia/examples/api/editrow/<row_id>"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key row-id)
|
||||
(let ((name (request-form "name" ""))
|
||||
(price (request-form "price" "0"))
|
||||
(stock (request-form "stock" "0")))
|
||||
(state-set! (str "ex-row-" row-id)
|
||||
{"id" row-id "name" name "price" price "stock" stock})
|
||||
(<>
|
||||
(~edit-row-view :id row-id :name name :price price :stock stock)
|
||||
(~doc-oob-code :target-id "editrow-comp"
|
||||
:text (component-source "edit-row-view"))
|
||||
(~doc-oob-code :target-id "editrow-wire"
|
||||
:text (str "(~edit-row-view :id \"" row-id "\" ...)")))))
|
||||
|
||||
(defhandler ex-editrow-cancel
|
||||
:path "/geography/hypermedia/examples/api/editrow/<row_id>/cancel"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key row-id)
|
||||
(let ((default (get edit-row-defaults row-id {"id" row-id "name" "" "price" "0" "stock" "0"})))
|
||||
(let ((row (state-get (str "ex-row-" row-id) default)))
|
||||
(<>
|
||||
(~edit-row-view :id (get row "id") :name (get row "name")
|
||||
:price (get row "price") :stock (get row "stock"))
|
||||
(~doc-oob-code :target-id "editrow-comp"
|
||||
:text (component-source "edit-row-view"))
|
||||
(~doc-oob-code :target-id "editrow-wire"
|
||||
:text (str "(~edit-row-view :id \"" (get row "id") "\" ...)"))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Bulk Update
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-bulk
|
||||
:path "/geography/hypermedia/examples/api/bulk"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((action (request-arg "action" "activate"))
|
||||
(ids (request-form-list "ids")))
|
||||
(let ((new-status (if (= action "activate") "active" "inactive")))
|
||||
;; Update matching users in state
|
||||
(for-each (fn (uid)
|
||||
(let ((default (get bulk-user-defaults uid nil)))
|
||||
(let ((user (state-get (str "ex-bulk-" uid) default)))
|
||||
(when user
|
||||
(state-set! (str "ex-bulk-" uid)
|
||||
(assoc user "status" new-status))))))
|
||||
ids)
|
||||
;; Return all rows
|
||||
(let ((rows (map (fn (uid)
|
||||
(let ((default (get bulk-user-defaults uid
|
||||
{"id" uid "name" "" "email" "" "status" "active"})))
|
||||
(let ((u (state-get (str "ex-bulk-" uid) default)))
|
||||
(~bulk-row :id (get u "id") :name (get u "name")
|
||||
:email (get u "email") :status (get u "status")))))
|
||||
(list "1" "2" "3" "4" "5"))))
|
||||
(<>
|
||||
rows
|
||||
(~doc-oob-code :target-id "bulk-comp"
|
||||
:text (component-source "bulk-row"))
|
||||
(~doc-oob-code :target-id "bulk-wire"
|
||||
:text (str "(updated " (len ids) " users to " new-status ")")))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Swap Positions
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-swap-log
|
||||
:path "/geography/hypermedia/examples/api/swap-log"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((mode (request-arg "mode" "beforeend"))
|
||||
(n (+ (state-get "ex-swap-n" 0) 1))
|
||||
(now (now "%H:%M:%S")))
|
||||
(state-set! "ex-swap-n" n)
|
||||
(<>
|
||||
(div :class "px-3 py-2 text-sm text-stone-700"
|
||||
(str "[" now "] " mode " (#" n ")"))
|
||||
(span :id "swap-counter" :sx-swap-oob "innerHTML"
|
||||
:class "self-center text-sm text-stone-500"
|
||||
(str "Count: " n))
|
||||
(~doc-oob-code :target-id "swap-wire"
|
||||
:text (str "(entry + oob counter: " n ")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Select Filter (Dashboard)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-dashboard
|
||||
:path "/geography/hypermedia/examples/api/dashboard"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(div :id "dash-header" :class "p-3 bg-violet-50 rounded mb-3"
|
||||
(h4 :class "font-semibold text-violet-800" "Dashboard Header")
|
||||
(p :class "text-sm text-violet-600" (str "Generated at " now)))
|
||||
(div :id "dash-stats" :class "grid grid-cols-3 gap-3 mb-3"
|
||||
(div :class "p-3 bg-emerald-50 rounded text-center"
|
||||
(p :class "text-2xl font-bold text-emerald-700" "142")
|
||||
(p :class "text-xs text-emerald-600" "Users"))
|
||||
(div :class "p-3 bg-blue-50 rounded text-center"
|
||||
(p :class "text-2xl font-bold text-blue-700" "89")
|
||||
(p :class "text-xs text-blue-600" "Orders"))
|
||||
(div :class "p-3 bg-amber-50 rounded text-center"
|
||||
(p :class "text-2xl font-bold text-amber-700" "$4.2k")
|
||||
(p :class "text-xs text-amber-600" "Revenue")))
|
||||
(div :id "dash-footer" :class "p-3 bg-stone-50 rounded"
|
||||
(p :class "text-sm text-stone-500" (str "Last updated: " now)))
|
||||
(~doc-oob-code :target-id "filter-wire"
|
||||
:text (str "(<> (div :id \"dash-header\" ...) (div :id \"dash-stats\" ...) (div :id \"dash-footer\" ...))")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Tabs
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-tabs
|
||||
:path "/geography/hypermedia/examples/api/tabs/<tab>"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key tab)
|
||||
(let ((content (get tab-content tab (get tab-content "tab1"))))
|
||||
(<>
|
||||
content
|
||||
(div :id "tab-buttons" :sx-swap-oob "innerHTML"
|
||||
:class "flex border-b border-stone-200"
|
||||
(~tab-btn :tab "tab1" :label "Overview" :active (if (= tab "tab1") "true" "false"))
|
||||
(~tab-btn :tab "tab2" :label "Details" :active (if (= tab "tab2") "true" "false"))
|
||||
(~tab-btn :tab "tab3" :label "History" :active (if (= tab "tab3") "true" "false")))
|
||||
(~doc-oob-code :target-id "tabs-wire"
|
||||
:text (str "(content for " tab " + oob tab buttons")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Animations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-animate
|
||||
:path "/geography/hypermedia/examples/api/animate"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((idx (random-int 0 4))
|
||||
(now (now "%H:%M:%S")))
|
||||
(let ((color (nth anim-colors idx)))
|
||||
(<>
|
||||
(~anim-result :color color :time now)
|
||||
(~doc-oob-code :target-id "anim-comp"
|
||||
:text (component-source "anim-result"))
|
||||
(~doc-oob-code :target-id "anim-wire"
|
||||
:text (str "(~anim-result :color \"" color "\" :time \"" now "\")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dialogs
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-dialog
|
||||
:path "/geography/hypermedia/examples/api/dialog"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(<>
|
||||
(~dialog-modal :title "Confirm Action"
|
||||
:message "Are you sure you want to proceed? This is a demo dialog rendered entirely with sx components.")
|
||||
(~doc-oob-code :target-id "dialog-comp"
|
||||
:text (component-source "dialog-modal"))
|
||||
(~doc-oob-code :target-id "dialog-wire"
|
||||
:text "(~dialog-modal :title \"Confirm Action\" :message \"...\")")))
|
||||
|
||||
(defhandler ex-dialog-close
|
||||
:path "/geography/hypermedia/examples/api/dialog/close"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(<>
|
||||
(~doc-oob-code :target-id "dialog-wire"
|
||||
:text "(empty — dialog closed)")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Keyboard Shortcuts
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-keyboard
|
||||
:path "/geography/hypermedia/examples/api/keyboard"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((key (request-arg "key" "")))
|
||||
(let ((action (get kbd-actions key (str "Unknown key: " key))))
|
||||
(<>
|
||||
(~kbd-result :key key :action action)
|
||||
(~doc-oob-code :target-id "kbd-comp"
|
||||
:text (component-source "kbd-result"))
|
||||
(~doc-oob-code :target-id "kbd-wire"
|
||||
:text (str "(~kbd-result :key \"" key "\" :action \"" action "\")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; PUT / PATCH
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-pp-edit-all
|
||||
:path "/geography/hypermedia/examples/api/putpatch/edit-all"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((p (state-get "ex-profile"
|
||||
{"name" "Ada Lovelace" "email" "ada@example.com" "role" "Engineer"})))
|
||||
(<>
|
||||
(~pp-form-full :name (get p "name") :email (get p "email") :role (get p "role"))
|
||||
(~doc-oob-code :target-id "pp-comp"
|
||||
:text (component-source "pp-form-full"))
|
||||
(~doc-oob-code :target-id "pp-wire"
|
||||
:text (str "(~pp-form-full :name \"" (get p "name") "\" ...)")))))
|
||||
|
||||
(defhandler ex-pp-put
|
||||
:path "/geography/hypermedia/examples/api/putpatch"
|
||||
:method :put
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((name (request-form "name" ""))
|
||||
(email (request-form "email" ""))
|
||||
(role (request-form "role" "")))
|
||||
(state-set! "ex-profile" {"name" name "email" email "role" role})
|
||||
(<>
|
||||
(~pp-view :name name :email email :role role)
|
||||
(~doc-oob-code :target-id "pp-comp"
|
||||
:text (component-source "pp-view"))
|
||||
(~doc-oob-code :target-id "pp-wire"
|
||||
:text (str "(~pp-view :name \"" name "\" ...)")))))
|
||||
|
||||
(defhandler ex-pp-cancel
|
||||
:path "/geography/hypermedia/examples/api/putpatch/cancel"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((p (state-get "ex-profile"
|
||||
{"name" "Ada Lovelace" "email" "ada@example.com" "role" "Engineer"})))
|
||||
(<>
|
||||
(~pp-view :name (get p "name") :email (get p "email") :role (get p "role"))
|
||||
(~doc-oob-code :target-id "pp-comp"
|
||||
:text (component-source "pp-view"))
|
||||
(~doc-oob-code :target-id "pp-wire"
|
||||
:text (str "(~pp-view :name \"" (get p "name") "\" ...)")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; JSON Encoding
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-json-echo
|
||||
:path "/geography/hypermedia/examples/api/json-echo"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((data (request-json))
|
||||
(ct (request-content-type)))
|
||||
(let ((body (json-encode data)))
|
||||
(<>
|
||||
(~json-result :body body :content-type ct)
|
||||
(~doc-oob-code :target-id "json-comp"
|
||||
:text (component-source "json-result"))
|
||||
(~doc-oob-code :target-id "json-wire"
|
||||
:text (str "(~json-result :body \"" body "\" :content-type \"" ct "\")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Vals & Headers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-echo-vals
|
||||
:path "/geography/hypermedia/examples/api/echo-vals"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((vals (into (list) (request-args-all))))
|
||||
(let ((filtered (filter (fn (pair) (and (not (= (first pair) "_"))
|
||||
(not (= (first pair) "sx-request"))))
|
||||
vals)))
|
||||
(let ((items (map (fn (pair) (str (first pair) ": " (nth pair 1))) filtered)))
|
||||
(<>
|
||||
(~echo-result :label "values" :items items)
|
||||
(~doc-oob-code :target-id "vals-comp"
|
||||
:text (component-source "echo-result"))
|
||||
(~doc-oob-code :target-id "vals-wire"
|
||||
:text (str "(~echo-result :label \"values\" :items (list ...))")))))))
|
||||
|
||||
(defhandler ex-echo-headers
|
||||
:path "/geography/hypermedia/examples/api/echo-headers"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((all-headers (into (list) (request-headers-all))))
|
||||
(let ((custom (filter (fn (pair) (starts-with? (first pair) "x-")) all-headers)))
|
||||
(let ((items (map (fn (pair) (str (first pair) ": " (nth pair 1))) custom)))
|
||||
(<>
|
||||
(~echo-result :label "headers" :items items)
|
||||
(~doc-oob-code :target-id "vals-comp"
|
||||
:text (component-source "echo-result"))
|
||||
(~doc-oob-code :target-id "vals-wire"
|
||||
:text (str "(~echo-result :label \"headers\" :items (list ...))")))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Loading States
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-slow
|
||||
:path "/geography/hypermedia/examples/api/slow"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(sleep 2000)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(~loading-result :time now)
|
||||
(~doc-oob-code :target-id "loading-comp"
|
||||
:text (component-source "loading-result"))
|
||||
(~doc-oob-code :target-id "loading-wire"
|
||||
:text (str "(~loading-result :time \"" now "\")")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Request Abort (sync replace)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-slow-search
|
||||
:path "/geography/hypermedia/examples/api/slow-search"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((delay-ms (random-int 500 2000)))
|
||||
(sleep delay-ms)
|
||||
(let ((q (request-arg "q" "")))
|
||||
(<>
|
||||
(~sync-result :query q :delay (str delay-ms))
|
||||
(~doc-oob-code :target-id "sync-comp"
|
||||
:text (component-source "sync-result"))
|
||||
(~doc-oob-code :target-id "sync-wire"
|
||||
:text (str "(~sync-result :query \"" q "\" :delay \"" delay-ms "\")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Retry
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defhandler ex-flaky
|
||||
:path "/geography/hypermedia/examples/api/flaky"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((n (+ (state-get "ex-flaky-n" 0) 1)))
|
||||
(state-set! "ex-flaky-n" n)
|
||||
(if (not (= (mod n 3) 0))
|
||||
(do
|
||||
(set-response-status 503)
|
||||
"")
|
||||
(<>
|
||||
(~retry-result :attempt (str n) :message "Success! The endpoint finally responded.")
|
||||
(~doc-oob-code :target-id "retry-comp"
|
||||
:text (component-source "retry-result"))
|
||||
(~doc-oob-code :target-id "retry-wire"
|
||||
:text (str "(~retry-result :attempt \"" n "\" ...)"))))))
|
||||
297
sx/sx/handlers/ref-api.sx
Normal file
297
sx/sx/handlers/ref-api.sx
Normal file
@@ -0,0 +1,297 @@
|
||||
;; Reference API endpoints — live demos for hypermedia attribute docs
|
||||
;;
|
||||
;; These replace the Python endpoints in bp/pages/routes.py.
|
||||
;; Each defhandler with :path registers as a public route automatically.
|
||||
|
||||
;; --- sx-get demo: server time ---
|
||||
|
||||
(defhandler ref-time
|
||||
:path "/geography/hypermedia/reference/api/time"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(span :class "text-stone-800 text-sm" "Server time: " (strong now))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-get"
|
||||
:text (str "(span :class \"text-stone-800 text-sm\" \"Server time: \" (strong \"" now "\"))")))))
|
||||
|
||||
;; --- sx-post demo: greet ---
|
||||
|
||||
(defhandler ref-greet
|
||||
:path "/geography/hypermedia/reference/api/greet"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((name (request-form "name" "stranger")))
|
||||
(<>
|
||||
(span :class "text-stone-800 text-sm" "Hello, " (strong name) "!")
|
||||
(~doc-oob-code :target-id "ref-wire-sx-post"
|
||||
:text (str "(span :class \"text-stone-800 text-sm\" \"Hello, \" (strong \"" name "\") \"!\")")))))
|
||||
|
||||
;; --- sx-put demo: status update ---
|
||||
|
||||
(defhandler ref-status
|
||||
:path "/geography/hypermedia/reference/api/status"
|
||||
:method :put
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((status (request-form "status" "unknown")))
|
||||
(<>
|
||||
(span :class "text-stone-700 text-sm" "Status: " (strong status) " — updated via PUT")
|
||||
(~doc-oob-code :target-id "ref-wire-sx-put"
|
||||
:text (str "(span :class \"text-stone-700 text-sm\" \"Status: \" (strong \"" status "\") \" — updated via PUT\")")))))
|
||||
|
||||
;; --- sx-patch demo: theme ---
|
||||
|
||||
(defhandler ref-theme
|
||||
:path "/geography/hypermedia/reference/api/theme"
|
||||
:method :patch
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((theme (request-form "theme" "unknown")))
|
||||
(<>
|
||||
theme
|
||||
(~doc-oob-code :target-id "ref-wire-sx-patch"
|
||||
:text (str "\"" theme "\"")))))
|
||||
|
||||
;; --- sx-delete demo ---
|
||||
|
||||
(defhandler ref-delete-item
|
||||
:path "/geography/hypermedia/reference/api/item/<item_id>"
|
||||
:method :delete
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(<>
|
||||
(~doc-oob-code :target-id "ref-wire-sx-delete" :text "\"\"")))
|
||||
|
||||
;; --- sx-trigger demo: search ---
|
||||
|
||||
(defhandler ref-trigger-search
|
||||
:path "/geography/hypermedia/reference/api/trigger-search"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((q (request-arg "q" "")))
|
||||
(let ((sx-text (if (= q "")
|
||||
"(span :class \"text-stone-400 text-sm\" \"Start typing to trigger a search.\")"
|
||||
(str "(span :class \"text-stone-800 text-sm\" \"Results for: \" (strong \"" q "\"))"))))
|
||||
(<>
|
||||
(if (= q "")
|
||||
(span :class "text-stone-400 text-sm" "Start typing to trigger a search.")
|
||||
(span :class "text-stone-800 text-sm" "Results for: " (strong q)))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-trigger" :text sx-text)))))
|
||||
|
||||
;; --- sx-swap demo ---
|
||||
|
||||
(defhandler ref-swap-item
|
||||
:path "/geography/hypermedia/reference/api/swap-item"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(div :class "text-sm text-violet-700" (str "New item (" now ")"))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-swap"
|
||||
:text (str "(div :class \"text-sm text-violet-700\" \"New item (" now ")\")")))))
|
||||
|
||||
;; --- sx-swap-oob demo ---
|
||||
|
||||
(defhandler ref-oob
|
||||
:path "/geography/hypermedia/reference/api/oob"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(span :class "text-emerald-700 text-sm" "Main updated at " now)
|
||||
(div :id "ref-oob-side" :sx-swap-oob "innerHTML"
|
||||
(span :class "text-violet-700 text-sm" "OOB updated at " now))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-swap-oob"
|
||||
:text (str "(<> (span ... \"" now "\") (div :id \"ref-oob-side\" :sx-swap-oob \"innerHTML\" ...))")))))
|
||||
|
||||
;; --- sx-select demo ---
|
||||
|
||||
(defhandler ref-select-page
|
||||
:path "/geography/hypermedia/reference/api/select-page"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(<>
|
||||
(div :id "the-header" (h3 "Page header — not selected"))
|
||||
(div :id "the-content"
|
||||
(span :class "text-emerald-700 text-sm"
|
||||
"This fragment was selected from a larger response. Time: " now))
|
||||
(div :id "the-footer" (p "Page footer — not selected"))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-select"
|
||||
:text (str "(<> (div :id \"the-header\" ...) (div :id \"the-content\" ... \"" now "\") (div :id \"the-footer\" ...))")))))
|
||||
|
||||
;; --- sx-sync demo: slow echo ---
|
||||
|
||||
(defhandler ref-slow-echo
|
||||
:path "/geography/hypermedia/reference/api/slow-echo"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((q (request-arg "q" "")))
|
||||
(sleep 800)
|
||||
(<>
|
||||
(span :class "text-stone-800 text-sm" "Echo: " (strong q))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-sync"
|
||||
:text (str "(span :class \"text-stone-800 text-sm\" \"Echo: \" (strong \"" q "\"))")))))
|
||||
|
||||
;; --- sx-prompt demo ---
|
||||
|
||||
(defhandler ref-prompt-echo
|
||||
:path "/geography/hypermedia/reference/api/prompt-echo"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((name (request-header "SX-Prompt" "anonymous")))
|
||||
(<>
|
||||
(span :class "text-stone-800 text-sm" "Hello, " (strong name) "!")
|
||||
(~doc-oob-code :target-id "ref-wire-sx-prompt"
|
||||
:text (str "(span :class \"text-stone-800 text-sm\" \"Hello, \" (strong \"" name "\") \"!\")")))))
|
||||
|
||||
;; --- Error demo ---
|
||||
|
||||
(defhandler ref-error-500
|
||||
:path "/geography/hypermedia/reference/api/error-500"
|
||||
:method :get
|
||||
:returns "nil"
|
||||
(&key)
|
||||
(abort 500 "Server error"))
|
||||
|
||||
|
||||
;; ==========================================================================
|
||||
;; Remaining reference endpoints — migrated from Python
|
||||
;; ==========================================================================
|
||||
|
||||
;; --- sx-encoding demo: file upload name ---
|
||||
|
||||
(defhandler ref-upload-name
|
||||
:path "/geography/hypermedia/reference/api/upload-name"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((name (request-file-name "file")))
|
||||
(let ((display (if (nil? name) "(no file)" name)))
|
||||
(let ((sx-text (str "(span :class \"text-stone-800 text-sm\" \"Received: \" (strong \"" display "\"))")))
|
||||
(<>
|
||||
(span :class "text-stone-800 text-sm" "Received: " (strong display))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-encoding" :text sx-text))))))
|
||||
|
||||
;; --- sx-headers demo: echo custom headers ---
|
||||
|
||||
(defhandler ref-echo-headers
|
||||
:path "/geography/hypermedia/reference/api/echo-headers"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((all-headers (into (list) (request-headers-all))))
|
||||
(let ((custom (filter
|
||||
(fn (pair) (starts-with? (first pair) "x-"))
|
||||
all-headers)))
|
||||
(let ((sx-text
|
||||
(if (empty? custom)
|
||||
"(span :class \"text-stone-400 text-sm\" \"No custom headers received.\")"
|
||||
(str "(ul :class \"text-sm text-stone-700 space-y-1\" "
|
||||
(join " " (map (fn (pair) (str "(li (strong \"" (first pair) "\") \": \" \"" (nth pair 1) "\")")) custom))
|
||||
")"))))
|
||||
(<>
|
||||
(if (empty? custom)
|
||||
(span :class "text-stone-400 text-sm" "No custom headers received.")
|
||||
(ul :class "text-sm text-stone-700 space-y-1"
|
||||
(map (fn (pair) (li (strong (first pair)) ": " (nth pair 1))) custom)))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-headers" :text sx-text))))))
|
||||
|
||||
;; --- sx-include demo: echo GET query params ---
|
||||
|
||||
(defhandler ref-echo-vals-get
|
||||
:path "/geography/hypermedia/reference/api/echo-vals"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((vals (into (list) (request-args-all))))
|
||||
(let ((sx-text
|
||||
(if (empty? vals)
|
||||
"(span :class \"text-stone-400 text-sm\" \"No values received.\")"
|
||||
(str "(ul :class \"text-sm text-stone-700 space-y-1\" "
|
||||
(join " " (map (fn (pair) (str "(li (strong \"" (first pair) "\") \": \" \"" (nth pair 1) "\")")) vals))
|
||||
")"))))
|
||||
(<>
|
||||
(if (empty? vals)
|
||||
(span :class "text-stone-400 text-sm" "No values received.")
|
||||
(ul :class "text-sm text-stone-700 space-y-1"
|
||||
(map (fn (pair) (li (strong (first pair)) ": " (nth pair 1))) vals)))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-include" :text sx-text)))))
|
||||
|
||||
;; --- sx-vals demo: echo POST form values ---
|
||||
|
||||
(defhandler ref-echo-vals-post
|
||||
:path "/geography/hypermedia/reference/api/echo-vals"
|
||||
:method :post
|
||||
:csrf false
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((vals (into (list) (request-form-all))))
|
||||
(let ((sx-text
|
||||
(if (empty? vals)
|
||||
"(span :class \"text-stone-400 text-sm\" \"No values received.\")"
|
||||
(str "(ul :class \"text-sm text-stone-700 space-y-1\" "
|
||||
(join " " (map (fn (pair) (str "(li (strong \"" (first pair) "\") \": \" \"" (nth pair 1) "\")")) vals))
|
||||
")"))))
|
||||
(<>
|
||||
(if (empty? vals)
|
||||
(span :class "text-stone-400 text-sm" "No values received.")
|
||||
(ul :class "text-sm text-stone-700 space-y-1"
|
||||
(map (fn (pair) (li (strong (first pair)) ": " (nth pair 1))) vals)))
|
||||
(~doc-oob-code :target-id "ref-wire-sx-vals" :text sx-text)))))
|
||||
|
||||
;; --- sx-retry demo: flaky endpoint (fails 2/3 times) ---
|
||||
|
||||
(defhandler ref-flaky
|
||||
:path "/geography/hypermedia/reference/api/flaky"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((n (+ (state-get "ref-flaky-n" 0) 1)))
|
||||
(state-set! "ref-flaky-n" n)
|
||||
(if (not (= (mod n 3) 0))
|
||||
(do
|
||||
(set-response-status 503)
|
||||
"")
|
||||
(let ((sx-text (str "(span :class \"text-emerald-700 text-sm\" \"Success on attempt \" \"" n "\" \"!\")")))
|
||||
(<>
|
||||
(span :class "text-emerald-700 text-sm" "Success on attempt " (str n) "!")
|
||||
(~doc-oob-code :target-id "ref-wire-sx-retry" :text sx-text))))))
|
||||
|
||||
;; --- sx-trigger-event demo: response header triggers ---
|
||||
|
||||
(defhandler ref-trigger-event
|
||||
:path "/geography/hypermedia/reference/api/trigger-event"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(set-response-header "SX-Trigger" "showNotice")
|
||||
(<>
|
||||
(span :class "text-stone-800 text-sm" "Loaded at " (strong now) " — check the border!"))))
|
||||
|
||||
;; --- sx-retarget demo: response header retargets ---
|
||||
|
||||
(defhandler ref-retarget
|
||||
:path "/geography/hypermedia/reference/api/retarget"
|
||||
:method :get
|
||||
:returns "element"
|
||||
(&key)
|
||||
(let ((now (now "%H:%M:%S")))
|
||||
(set-response-header "SX-Retarget" "#ref-hdr-retarget-alt")
|
||||
(<>
|
||||
(span :class "text-violet-700 text-sm" "Retargeted at " (strong now)))))
|
||||
@@ -95,7 +95,9 @@
|
||||
(dict :label "React is Hypermedia" :href "/etc/essays/react-is-hypermedia"
|
||||
:summary "A React Island is a hypermedia control. Its behavior is specified in SX.")
|
||||
(dict :label "The Hegelian Synthesis" :href "/etc/essays/hegelian-synthesis"
|
||||
:summary "On the dialectical resolution of the hypertext/reactive contradiction. Thesis: the server renders. Antithesis: the client reacts. Synthesis: the island in the lake.")))
|
||||
:summary "On the dialectical resolution of the hypertext/reactive contradiction. Thesis: the server renders. Antithesis: the client reacts. Synthesis: the island in the lake.")
|
||||
(dict :label "The Art Chain" :href "/etc/essays/the-art-chain"
|
||||
:summary "On making, self-making, and the chain of artifacts that produces itself. Ars, techne, content addressing, and why the spec is the art.")))
|
||||
|
||||
(define philosophy-nav-items (list
|
||||
(dict :label "The SX Manifesto" :href "/etc/philosophy/sx-manifesto"
|
||||
@@ -110,25 +112,33 @@
|
||||
:summary "Existence precedes essence — Sartre, Camus, and the absurd freedom of writing a Lisp for the web.")))
|
||||
|
||||
(define specs-nav-items (list
|
||||
(dict :label "Architecture" :href "/language/specs/")
|
||||
(dict :label "Core" :href "/language/specs/core")
|
||||
(dict :label "Parser" :href "/language/specs/parser")
|
||||
(dict :label "Evaluator" :href "/language/specs/evaluator")
|
||||
(dict :label "Primitives" :href "/language/specs/primitives")
|
||||
(dict :label "Special Forms" :href "/language/specs/special-forms")
|
||||
(dict :label "Renderer" :href "/language/specs/renderer")
|
||||
(dict :label "Adapters" :href "/language/specs/adapters")
|
||||
(dict :label "DOM Adapter" :href "/language/specs/adapter-dom")
|
||||
(dict :label "HTML Adapter" :href "/language/specs/adapter-html")
|
||||
(dict :label "SX Wire Adapter" :href "/language/specs/adapter-sx")
|
||||
(dict :label "Browser" :href "/language/specs/browser")
|
||||
(dict :label "SxEngine" :href "/language/specs/engine")
|
||||
(dict :label "Orchestration" :href "/language/specs/orchestration")
|
||||
(dict :label "Boot" :href "/language/specs/boot")
|
||||
(dict :label "Continuations" :href "/language/specs/continuations")
|
||||
(dict :label "call/cc" :href "/language/specs/callcc")
|
||||
(dict :label "Deps" :href "/language/specs/deps")
|
||||
(dict :label "Router" :href "/language/specs/router")))
|
||||
{:label "Core" :href "/language/specs/core" :children (list
|
||||
{:label "Parser" :href "/language/specs/parser"}
|
||||
{:label "Evaluator" :href "/language/specs/evaluator"}
|
||||
{:label "Primitives" :href "/language/specs/primitives"}
|
||||
{:label "Special Forms" :href "/language/specs/special-forms"}
|
||||
{:label "Renderer" :href "/language/specs/renderer"})}
|
||||
{:label "Adapters" :href "/language/specs/adapters" :children (list
|
||||
{:label "DOM Adapter" :href "/language/specs/adapter-dom"}
|
||||
{:label "HTML Adapter" :href "/language/specs/adapter-html"}
|
||||
{:label "SX Wire Adapter" :href "/language/specs/adapter-sx"}
|
||||
{:label "Async Adapter" :href "/language/specs/adapter-async"})}
|
||||
{:label "Browser" :href "/language/specs/browser" :children (list
|
||||
{:label "SxEngine" :href "/language/specs/engine"}
|
||||
{:label "Orchestration" :href "/language/specs/orchestration"}
|
||||
{:label "Boot" :href "/language/specs/boot"}
|
||||
{:label "Router" :href "/language/specs/router"})}
|
||||
{:label "Reactive" :href "/language/specs/reactive" :children (list
|
||||
{:label "Signals" :href "/language/specs/signals"})}
|
||||
{:label "Host Interface" :href "/language/specs/host" :children (list
|
||||
{:label "Boundary" :href "/language/specs/boundary"}
|
||||
{:label "Forms" :href "/language/specs/forms"}
|
||||
{:label "Page Helpers" :href "/language/specs/page-helpers"})}
|
||||
{:label "Extensions" :href "/language/specs/extensions" :children (list
|
||||
{:label "Continuations" :href "/language/specs/continuations"}
|
||||
{:label "call/cc" :href "/language/specs/callcc"}
|
||||
{:label "Types" :href "/language/specs/types"}
|
||||
{:label "Deps" :href "/language/specs/deps"})}))
|
||||
|
||||
(define testing-nav-items (list
|
||||
(dict :label "Overview" :href "/language/testing/")
|
||||
@@ -204,7 +214,9 @@
|
||||
(dict :label "Generative SX" :href "/etc/plans/generative-sx"
|
||||
:summary "Programs that write themselves as they run — self-compiling specs, runtime self-extension, generative testing, seed networks.")
|
||||
(dict :label "Art DAG on SX" :href "/etc/plans/art-dag-sx"
|
||||
:summary "SX endpoints as portals into media processing environments — recipes as programs, split execution across GPU/cache/live boundaries, streaming AV output.")))
|
||||
:summary "SX endpoints as portals into media processing environments — recipes as programs, split execution across GPU/cache/live boundaries, streaming AV output.")
|
||||
(dict :label "Spec Explorer" :href "/etc/plans/spec-explorer"
|
||||
:summary "The fifth ring — SX exploring itself. Per-function cards showing source, Python/JS/Z3 translations, platform dependencies, tests, proofs, and usage examples.")))
|
||||
|
||||
(define reactive-islands-nav-items (list
|
||||
(dict :label "Overview" :href "/geography/reactive/"
|
||||
@@ -260,17 +272,39 @@
|
||||
(dict :slug "adapter-sx" :filename "adapter-sx.sx" :title "SX Wire Adapter"
|
||||
:desc "Serializes SX for client-side rendering. Component calls stay unexpanded."
|
||||
:prose "The SX wire adapter serializes expressions as SX source text for transmission to the browser, where sx.js renders them client-side. Unlike the HTML adapter, component calls (~name ...) are NOT expanded — they are sent to the client as-is, allowing the browser to render them with its local component registry. HTML tags ARE serialized as s-expression source. This is the format used for SX-over-HTTP responses and the page boot payload.")
|
||||
(dict :slug "adapter-async" :filename "adapter-async.sx" :title "Async Adapter"
|
||||
:desc "Async versions of HTML and SX wire adapters for server-side rendering with I/O."
|
||||
:prose "The async adapter provides async-aware versions of the HTML and SX wire rendering functions. It intercepts I/O operations (database queries, service calls, fragment fetches) during evaluation, awaiting them before continuing. Entry points: async-render (HTML output with awaited I/O), async-aser (SX wire format with awaited I/O). The bootstrapper emits async def and automatic await insertion for all define-async functions. This adapter is what makes server-side SX pages work with real data.")))
|
||||
|
||||
(define browser-spec-items (list
|
||||
(dict :slug "engine" :filename "engine.sx" :title "SxEngine"
|
||||
:desc "Pure logic for fetch, swap, history, SSE, triggers, morph, and indicators."
|
||||
:prose "The engine specifies the pure logic of the browser-side fetch/swap/history system. Like HTMX but native to SX. It defines trigger parsing (click, submit, intersect, poll, load, revealed), swap algorithms (innerHTML, outerHTML, morph, beforebegin, etc.), the morph/diff algorithm for patching existing DOM, history management (push-url, replace-url, popstate), out-of-band swap identification, Server-Sent Events parsing, retry logic with exponential backoff, request header building, response header processing, and optimistic UI updates. This file contains no browser API calls — all platform interaction is in orchestration.sx.")
|
||||
(dict :slug "orchestration" :filename "orchestration.sx" :title "Orchestration"
|
||||
:desc "Browser wiring that binds engine logic to DOM events, fetch, and lifecycle."
|
||||
:prose "Orchestration is the browser wiring layer. It binds the pure engine logic to actual browser APIs: DOM event listeners, fetch(), AbortController, setTimeout/setInterval, IntersectionObserver, history.pushState, and EventSource (SSE). It implements the full request lifecycle — from trigger through fetch through swap — including CSS tracking, response type detection (SX vs HTML), OOB swap processing, script activation, element boosting, and preload. Dependency is strictly one-way: orchestration depends on engine, never the reverse.")))
|
||||
|
||||
(define browser-spec-items (list
|
||||
:prose "Orchestration is the browser wiring layer. It binds the pure engine logic to actual browser APIs: DOM event listeners, fetch(), AbortController, setTimeout/setInterval, IntersectionObserver, history.pushState, and EventSource (SSE). It implements the full request lifecycle — from trigger through fetch through swap — including CSS tracking, response type detection (SX vs HTML), OOB swap processing, script activation, element boosting, and preload. Dependency is strictly one-way: orchestration depends on engine, never the reverse.")
|
||||
(dict :slug "boot" :filename "boot.sx" :title "Boot"
|
||||
:desc "Browser startup lifecycle: mount, hydrate, script processing."
|
||||
:prose "Boot handles the browser startup sequence and provides the public API for mounting SX content. On page load it: (1) initializes CSS tracking, (2) processes <script type=\"text/sx\"> tags (component definitions and mount directives), (3) hydrates [data-sx] elements, and (4) activates the engine on all elements. It also provides the public mount/hydrate/update/render-component API, and the head element hoisting logic that moves <meta>, <title>, and <link> tags from rendered content into <head>.")))
|
||||
:prose "Boot handles the browser startup sequence and provides the public API for mounting SX content. On page load it: (1) initializes CSS tracking, (2) processes <script type=\"text/sx\"> tags (component definitions and mount directives), (3) hydrates [data-sx] elements, and (4) activates the engine on all elements. It also provides the public mount/hydrate/update/render-component API, and the head element hoisting logic that moves <meta>, <title>, and <link> tags from rendered content into <head>.")
|
||||
(dict :slug "router" :filename "router.sx" :title "Router"
|
||||
:desc "Client-side route matching — Flask-style pattern parsing, segment matching, route table search."
|
||||
:prose "The router module provides pure functions for matching URL paths against Flask-style route patterns (e.g. /docs/<slug>). Used by client-side routing to determine if a page can be rendered locally without a server roundtrip. split-path-segments breaks a path into segments, parse-route-pattern converts patterns into typed segment descriptors, match-route-segments tests a path against a parsed pattern returning extracted params, and find-matching-route searches a route table for the first match.")))
|
||||
|
||||
(define reactive-spec-items (list
|
||||
(dict :slug "signals" :filename "signals.sx" :title "Signals"
|
||||
:desc "Fine-grained reactive primitives — signal, computed, effect, batch."
|
||||
:prose "The signals module defines a fine-grained reactive system for client-side islands. Signals are containers for values that notify subscribers on change. Computed signals derive values lazily from other signals. Effects run side-effects when their dependencies change, with automatic cleanup. Batch coalesces multiple signal writes into a single notification pass. Island scope management ensures all signals, computeds, and effects are cleaned up when an island is removed from the DOM. The spec defines the reactive graph topology and update algorithm — each platform implements the actual signal/tracking types natively.")))
|
||||
|
||||
(define host-spec-items (list
|
||||
(dict :slug "boundary" :filename "boundary.sx" :title "Boundary"
|
||||
:desc "Language boundary contract — declares I/O primitives the host must provide."
|
||||
:prose "The boundary defines the contract between SX and its host environment. Tier 1 declares pure primitives (from primitives.sx). Tier 2 declares async I/O primitives the host must implement: fetch, async-eval, call-action, send-activity, and other operations that require network or database access. Tier 3 declares page helpers: format, highlight, scan-css-classes, parse-datetime. This is the interface every host must satisfy to run SX — framework-agnostic, universal to all targets. Boundary enforcement validates at registration time that all declared primitives are provided.")
|
||||
(dict :slug "forms" :filename "forms.sx" :title "Forms"
|
||||
:desc "Server-side definition forms — defhandler, defquery, defaction, defpage."
|
||||
:prose "Forms defines the server-side definition macros that compose the application layer. defhandler registers an HTTP route handler. defquery defines a read-only data source. defaction defines a mutation (write). defpage declares a client-routable page with path, auth, layout, data dependencies, and content. Each form parses &key parameter lists and creates typed definition objects. Platform-specific constructors are provided by the host — these have different bindings on server (Python/Quart) vs client (route matching only).")
|
||||
(dict :slug "page-helpers" :filename "page-helpers.sx" :title "Page Helpers"
|
||||
:desc "Pure data-transformation helpers for page rendering."
|
||||
:prose "Page helpers are pure functions that assist page rendering: categorizing special forms by type, formatting numbers and dates, highlighting code, scanning CSS classes, constructing page titles and descriptions. Unlike boundary I/O primitives, these are pure — they take data and return data with no side effects. They run identically on server and client. The host registers native implementations that match these declarations.")))
|
||||
|
||||
(define extension-spec-items (list
|
||||
(dict :slug "continuations" :filename "continuations.sx" :title "Continuations"
|
||||
@@ -278,17 +312,15 @@
|
||||
:prose "Delimited continuations capture the rest of a computation up to a delimiter. shift captures the continuation to the nearest reset as a first-class callable value. Unlike full call/cc, delimited continuations are composable — invoking one returns a value. This covers the practical use cases: suspendable server rendering, cooperative scheduling, linear async flows, wizard-style multi-step UIs, and undo. Each bootstrapper target implements the mechanism differently — generators in Python/JS, native shift/reset in Scheme, ContT in Haskell, CPS transform in Rust — but the semantics are identical. Optional extension: code that doesn't use continuations pays zero cost.")
|
||||
(dict :slug "callcc" :filename "callcc.sx" :title "call/cc"
|
||||
:desc "Full first-class continuations — call-with-current-continuation."
|
||||
:prose "Full call/cc captures the entire remaining computation as a first-class function — not just up to a delimiter, but all the way to the top level. Invoking the continuation abandons the current computation entirely and resumes from where it was captured. Strictly more powerful than delimited continuations, but harder to implement in targets that don't support it natively. Recommended for Scheme and Haskell targets where it's natural. Python, JavaScript, and Rust targets should prefer delimited continuations (continuations.sx) unless full escape semantics are genuinely needed. Optional extension: the continuation type is shared with continuations.sx if both are loaded.")))
|
||||
|
||||
(define module-spec-items (list
|
||||
:prose "Full call/cc captures the entire remaining computation as a first-class function — not just up to a delimiter, but all the way to the top level. Invoking the continuation abandons the current computation entirely and resumes from where it was captured. Strictly more powerful than delimited continuations, but harder to implement in targets that don't support it natively. Recommended for Scheme and Haskell targets where it's natural. Python, JavaScript, and Rust targets should prefer delimited continuations (continuations.sx) unless full escape semantics are genuinely needed. Optional extension: the continuation type is shared with continuations.sx if both are loaded.")
|
||||
(dict :slug "types" :filename "types.sx" :title "Types"
|
||||
:desc "Gradual type system — registration-time checking with zero runtime cost."
|
||||
:prose "The types module defines a gradual type system for SX. Type annotations on function parameters and return values are checked at registration time (when defcomp or define is evaluated), not at every call site. Base types include number, string, boolean, nil, symbol, keyword, element, any, and never. Union types (string|nil), function types, and type narrowing through control flow are supported. The system catches composition errors and boundary mismatches at definition time without any runtime overhead — unannotated code is unaffected.")
|
||||
(dict :slug "deps" :filename "deps.sx" :title "Deps"
|
||||
:desc "Component dependency analysis and IO detection — per-page bundling, transitive closure, CSS scoping, pure/IO classification."
|
||||
:prose "The deps module analyzes component dependency graphs and classifies components as pure or IO-dependent. Phase 1 (bundling): walks component AST bodies to find transitive ~component references, computes the minimal set needed per page, and collects per-page CSS classes from only the used components. Phase 2 (IO detection): scans component ASTs for references to IO primitive names (from boundary.sx declarations — frag, query, service, current-user, highlight, etc.), computes transitive IO refs through the component graph, and caches the result on each component. Components with no transitive IO refs are pure — they can render anywhere without server data. IO-dependent components must expand server-side. The spec provides the classification; each host's async partial evaluator acts on it (expand IO-dependent server-side, serialize pure for client). All functions are pure — each host bootstraps them to native code via --spec-modules deps. Platform functions (component-deps, component-set-deps!, component-css-classes, component-io-refs, component-set-io-refs!, env-components, regex-find-all, scan-css-classes) are implemented natively per target.")
|
||||
(dict :slug "router" :filename "router.sx" :title "Router"
|
||||
:desc "Client-side route matching — Flask-style pattern parsing, segment matching, route table search."
|
||||
:prose "The router module provides pure functions for matching URL paths against Flask-style route patterns (e.g. /docs/<slug>). Used by client-side routing (Phase 3) to determine if a page can be rendered locally without a server roundtrip. split-path-segments breaks a path into segments, parse-route-pattern converts patterns into typed segment descriptors, match-route-segments tests a path against a parsed pattern returning extracted params, and find-matching-route searches a route table for the first match. No platform interface needed — uses only pure string and list primitives. Bootstrapped via --spec-modules deps,router.")))
|
||||
:desc "Component dependency analysis and IO detection — per-page bundling, transitive closure, CSS scoping."
|
||||
:prose "The deps module analyzes component dependency graphs and classifies components as pure or IO-dependent. Phase 1 (bundling): walks component AST bodies to find transitive ~component references, computes the minimal set needed per page, and collects per-page CSS classes from only the used components. Phase 2 (IO detection): scans component ASTs for references to IO primitive names (from boundary.sx declarations), computes transitive IO refs through the component graph, and caches the result. Components with no transitive IO refs are pure — they can render anywhere without server data. IO-dependent components must expand server-side.")))
|
||||
|
||||
(define all-spec-items (concat core-spec-items (concat adapter-spec-items (concat browser-spec-items (concat extension-spec-items module-spec-items)))))
|
||||
(define all-spec-items (concat core-spec-items (concat adapter-spec-items (concat browser-spec-items (concat reactive-spec-items (concat host-spec-items extension-spec-items))))))
|
||||
|
||||
(define find-spec
|
||||
(fn (slug)
|
||||
|
||||
213
sx/sx/plans/spec-explorer.sx
Normal file
213
sx/sx/plans/spec-explorer.sx
Normal file
@@ -0,0 +1,213 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Spec Explorer — The Fifth Ring
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~plan-spec-explorer-content ()
|
||||
(~doc-page :title "Spec Explorer"
|
||||
|
||||
(~doc-section :title "The Five Rings" :id "five-rings"
|
||||
(p "SX has a peculiar architecture. At its centre sits a specification — a set of s-expression files that define the language. Not a description of the language. Not documentation about the language. The specification " (em "is") " the language. It is simultaneously a formal definition and executable code. You can read it as a document or run it as a program. It does not describe how to build an SX evaluator; it " (em "is") " an SX evaluator, expressed in the language it defines.")
|
||||
(p "This is the nucleus. Everything else radiates outward from it.")
|
||||
|
||||
(div :class "space-y-3 my-4"
|
||||
(div :class "rounded border border-violet-200 bg-violet-50/50 p-4"
|
||||
(div :class "flex items-center gap-2 mb-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-violet-600 text-white" "1")
|
||||
(span :class "font-semibold text-stone-800" "The Nucleus"))
|
||||
(p :class "text-sm text-stone-600" "The spec itself — " (code "shared/sx/ref/*.sx") ". Fourteen files, 180+ functions with type and effect annotations. Each function is simultaneously a formal definition and executable code."))
|
||||
|
||||
(div :class "rounded border border-sky-200 bg-sky-50/50 p-4"
|
||||
(div :class "flex items-center gap-2 mb-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-sky-600 text-white" "2")
|
||||
(span :class "font-semibold text-stone-800" "The Bootstrapper Ring"))
|
||||
(p :class "text-sm text-stone-600" "Translators that read the spec and emit native implementations. " (code "bootstrap_py.py") " emits Python. " (code "js.sx") " emits JavaScript. " (code "z3.sx") " emits SMT-LIB verification conditions. The spec's knowledge is preserved in every translation. Nothing is added, nothing is lost."))
|
||||
|
||||
(div :class "rounded border border-rose-200 bg-rose-50/50 p-4"
|
||||
(div :class "flex items-center gap-2 mb-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-rose-500 text-white" "3")
|
||||
(span :class "font-semibold text-stone-800" "The Bridge Ring"))
|
||||
(p :class "text-sm text-stone-600" "The platform boundary — " (code "boundary.sx") " is literally the membrane between the made world (the spec) and the found world (the host environment). It declares what the host must provide so the spec can function. Each spec function's dependencies trace back to either other spec functions or platform primitives."))
|
||||
|
||||
(div :class "rounded border border-amber-200 bg-amber-50/50 p-4"
|
||||
(div :class "flex items-center gap-2 mb-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-amber-500 text-white" "4")
|
||||
(span :class "font-semibold text-stone-800" "The Runtime Ring"))
|
||||
(p :class "text-sm text-stone-600" "Bootstrapped spec + platform bridge = working system. Tests verify behaviour. " (code "prove.sx") " verifies algebraic properties by bounded model checking. " (code "z3.sx") " translates to SMT-LIB for unbounded proofs. The spec doesn't just claim to work — it proves it."))
|
||||
|
||||
(div :class "rounded border border-green-200 bg-green-50/50 p-4"
|
||||
(div :class "flex items-center gap-2 mb-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-green-600 text-white" "5")
|
||||
(span :class "font-semibold text-stone-800" "The Application Ring"))
|
||||
(p :class "text-sm text-stone-600" "This website — rendering the spec's source code using the runtime the spec produced, displayed in components written in the language the spec defines, navigated by an engine the spec specifies. The documentation is the thing documenting itself.")))
|
||||
|
||||
(p "The spec explorer makes all five rings visible for every function."))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; What the explorer shows
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "Per-Function Cards" :id "cards"
|
||||
(p "Each function in the spec gets a card showing all five rings:")
|
||||
|
||||
(div :class "overflow-x-auto rounded border border-stone-200 mb-4"
|
||||
(table :class "w-full text-left text-sm"
|
||||
(thead (tr :class "border-b border-stone-200 bg-stone-100"
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Ring")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Panel")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Content")))
|
||||
(tbody
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-violet-600 text-white" "1"))
|
||||
(td :class "px-3 py-2 font-semibold text-stone-700" "Nucleus")
|
||||
(td :class "px-3 py-2 text-stone-600" "SX source with syntax highlighting. Effect badges (pure/mutation/io/render). Typed parameter list."))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-sky-600 text-white" "2"))
|
||||
(td :class "px-3 py-2 font-semibold text-stone-700" "Translations")
|
||||
(td :class "px-3 py-2 text-stone-600" "Collapsible panels showing the same function in Python, JavaScript, and Z3/SMT-LIB. Each generated by the actual bootstrappers — not hand-written."))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-rose-500 text-white" "3"))
|
||||
(td :class "px-3 py-2 font-semibold text-stone-700" "Bridge")
|
||||
(td :class "px-3 py-2 text-stone-600" "Cross-references: which spec functions and platform primitives this function depends on. Platform deps marked with " (code "\u2B21") "."))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-amber-500 text-white" "4"))
|
||||
(td :class "px-3 py-2 font-semibold text-stone-700" "Runtime")
|
||||
(td :class "px-3 py-2 text-stone-600" "Tests matched from " (code "test-*.sx") " files. Proof status from " (code "prove.sx") " — sat/unknown/n/a. Algebraic properties that reference this function."))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-green-600 text-white" "5"))
|
||||
(td :class "px-3 py-2 font-semibold text-stone-700" "Examples")
|
||||
(td :class "px-3 py-2 text-stone-600" "Usage examples extracted from comments, test assertions, and curated examples. Living documentation."))))))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Effect system
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "Effect Annotations" :id "effects"
|
||||
(p "Every function in the spec now carries an " (code ":effects") " annotation declaring what kind of side effects it performs:")
|
||||
|
||||
(div :class "flex flex-wrap gap-3 my-4"
|
||||
(span :class "inline-flex items-center gap-1 px-3 py-1 rounded bg-green-100 text-green-700 text-sm font-medium" "pure " (code ":effects []"))
|
||||
(span :class "inline-flex items-center gap-1 px-3 py-1 rounded bg-amber-100 text-amber-700 text-sm font-medium" "mutation " (code ":effects [mutation]"))
|
||||
(span :class "inline-flex items-center gap-1 px-3 py-1 rounded bg-orange-100 text-orange-700 text-sm font-medium" "io " (code ":effects [io]"))
|
||||
(span :class "inline-flex items-center gap-1 px-3 py-1 rounded bg-sky-100 text-sky-700 text-sm font-medium" "render " (code ":effects [render]")))
|
||||
|
||||
(p "The explorer shows effect badges on each function card, and the stats bar aggregates them across the whole file. Pure functions (green) are the nucleus — no side effects, fully deterministic, safe to cache, reorder, or parallelise.")
|
||||
|
||||
(~doc-code :code (highlight "(define signal :effects []\n (fn ((initial-value :as any))\n (make-signal initial-value)))\n\n(define reset! :effects [mutation]\n (fn ((s :as signal) value)\n (when (signal? s)\n (let ((old (signal-value s)))\n (when (not (identical? old value))\n (signal-set-value! s value)\n (notify-subscribers s))))))" "sx")))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Bootstrapper translations
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "Bootstrapper Translations" :id "translations"
|
||||
(p "Each function is translated by the actual bootstrappers that build the production runtime. The same " (code "signal") " function shown in three target languages:")
|
||||
|
||||
(~doc-subsection :title "Python (via bootstrap_py.py)"
|
||||
(~doc-code :code (highlight "def signal(initial_value):\n return make_signal(initial_value)" "python"))
|
||||
(p :class "text-sm text-stone-500" (code "PyEmitter._emit_define()") " — the exact same code path that generates " (code "sx_ref.py") "."))
|
||||
|
||||
(~doc-subsection :title "JavaScript (via js.sx)"
|
||||
(~doc-code :code (highlight "var signal = function(initial_value) {\n return make_signal(initial_value);\n};" "javascript"))
|
||||
(p :class "text-sm text-stone-500" (code "js-emit-define") " — the self-hosting JS bootstrapper, written in SX, evaluated by the Python evaluator."))
|
||||
|
||||
(~doc-subsection :title "Z3 / SMT-LIB (via z3.sx)"
|
||||
(~doc-code :code (highlight "; signal — Create a reactive signal container with an initial value.\n(declare-fun signal (Value) Value)" "lisp"))
|
||||
(p :class "text-sm text-stone-500" (code "z3-translate") " — the first self-hosted bootstrapper, translating spec declarations to verification conditions for theorem provers.")))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Testing and proving
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "Tests and Proofs" :id "runtime"
|
||||
(p "Ring 4 shows that the spec does what it claims.")
|
||||
|
||||
(~doc-subsection :title "Tests"
|
||||
(p "Test files (" (code "test-signals.sx") ", " (code "test-eval.sx") ", etc.) use the " (code "defsuite") "/" (code "deftest") " framework. The explorer matches tests to functions by suite name and shows them on the function card.")
|
||||
(~doc-code :code (highlight "(defsuite \"signal basics\"\n (deftest \"creates signal with value\"\n (let ((s (signal 42)))\n (assert-equal (deref s) 42)))\n (deftest \"reset changes value\"\n (let ((s (signal 0)))\n (reset! s 99)\n (assert-equal (deref s) 99))))" "sx")))
|
||||
|
||||
(~doc-subsection :title "Proofs"
|
||||
(p (code "prove.sx") " verifies algebraic properties of SX primitives by bounded model checking. For each " (code "define-primitive") " with a " (code ":body") ", " (code "prove-translate") " translates to SMT-LIB and verifies satisfiability by construction.")
|
||||
(p "Properties from the " (code "sx-properties") " library are matched to functions and shown on their cards:")
|
||||
(~doc-code :code (highlight ";; prove.sx property: +-commutative\n{:name \"+-commutative\"\n :vars (list \"a\" \"b\")\n :test (fn (a b) (= (+ a b) (+ b a)))\n :holds '(= (+ a b) (+ b a))}\n\n;; Result: verified — 1,681 ground instances tested" "sx"))))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Architecture
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "Implementation" :id "implementation"
|
||||
(p "Three layers, three increments.")
|
||||
|
||||
(~doc-subsection :title "Layer 1: Python helper"
|
||||
(p (code "spec-explorer-data(slug)") " in " (code "helpers.py") " — parses a " (code ".sx") " spec file via " (code "parse_all()") ", extracts sections/defines/effects/params, calls each bootstrapper for per-function translations, matches tests, runs proofs.")
|
||||
(p "This is the only new Python code. Everything else is SX components."))
|
||||
|
||||
(~doc-subsection :title "Layer 2: SX components"
|
||||
(p (code "specs-explorer.sx") " — 12-15 " (code "defcomp") " components rendering the structured data:")
|
||||
(div :class "overflow-x-auto"
|
||||
(pre :class "text-xs bg-stone-100 rounded p-3"
|
||||
(code "~spec-explorer-content top-level, receives parsed data\n ~spec-explorer-header filename, title, source link\n ~spec-explorer-stats aggregate badges: effects, tests, proofs\n ~spec-explorer-toc section table of contents\n ~spec-explorer-section one section with its defines\n ~spec-explorer-define one function card (all five rings)\n ~spec-effect-badge colored effect badge\n ~spec-param-list typed parameter list\n ~spec-ring-translations SX / Python / JS / Z3 panels\n ~spec-ring-bridge cross-references + platform deps\n ~spec-ring-runtime tests + proofs\n ~spec-ring-examples usage examples\n ~spec-platform-interface platform primitives table"))))
|
||||
|
||||
(~doc-subsection :title "Layer 3: Routing"
|
||||
(p "New route at " (code "/language/specs/explore/<slug>") " — parallel to existing raw source at " (code "/language/specs/<slug>") ". Each spec page gets an \"Explore\" link; the explorer gets a \"Source\" link.")))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Increments
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "Incremental Delivery" :id "increments"
|
||||
(div :class "space-y-4"
|
||||
|
||||
(div :class "rounded border border-stone-200 p-4"
|
||||
(div :class "flex items-center gap-2 mb-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-violet-600 text-white uppercase" "Inc 1")
|
||||
(span :class "font-semibold text-stone-800" "Core + Translations (Ring 1-2)"))
|
||||
(ul :class "list-disc pl-5 text-sm text-stone-600 space-y-1"
|
||||
(li (code "_spec_explorer_data()") " — sections, defines, effects, params, source extraction")
|
||||
(li "Python translation via " (code "PyEmitter._emit_define()"))
|
||||
(li "JavaScript translation via " (code "js-emit-define") " (from " (code "run_js_sx.py") ")")
|
||||
(li "Z3 translation via " (code "z3-translate") " (from " (code "z3.sx") ")")
|
||||
(li "Explorer components + translation panels + routing")
|
||||
(li "Test with " (code "signals.sx"))))
|
||||
|
||||
(div :class "rounded border border-stone-200 p-4"
|
||||
(div :class "flex items-center gap-2 mb-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-sky-600 text-white uppercase" "Inc 2")
|
||||
(span :class "font-semibold text-stone-800" "Bridge + Runtime (Ring 3-4)"))
|
||||
(ul :class "list-disc pl-5 text-sm text-stone-600 space-y-1"
|
||||
(li "Cross-reference index: function\u2192slug mapping across all spec files")
|
||||
(li "Platform dependency detection (ref not in index = platform primitive)")
|
||||
(li "Test file parsing: " (code "defsuite") "/" (code "deftest") " structure extraction")
|
||||
(li "Test-to-function matching")
|
||||
(li "Proof generation via " (code "prove-translate"))
|
||||
(li "Property matching from " (code "sx-properties"))))
|
||||
|
||||
(div :class "rounded border border-stone-200 p-4"
|
||||
(div :class "flex items-center gap-2 mb-2"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-green-600 text-white uppercase" "Inc 3")
|
||||
(span :class "font-semibold text-stone-800" "Examples + Polish (Ring 5)"))
|
||||
(ul :class "list-disc pl-5 text-sm text-stone-600 space-y-1"
|
||||
(li "Example extraction from comments + test assertions")
|
||||
(li "Curated examples for key functions")
|
||||
(li "Stats bar with aggregate counts")
|
||||
(li "Table of contents with anchor links")
|
||||
(li "Platform interface table")
|
||||
(li "View switcher links between source and explorer")))))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; The strange loop
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(~doc-section :title "The Strange Loop" :id "strange-loop"
|
||||
(p "When you view " (code "/language/specs/explore/eval") ", what happens is this:")
|
||||
(ol :class "list-decimal pl-5 text-stone-700 space-y-2"
|
||||
(li "The SX evaluator — bootstrapped from " (code "eval.sx") " — evaluates the page definition.")
|
||||
(li "The page calls " (code "spec-explorer-data(\"eval\")") ", which parses " (code "eval.sx") " using " (code "parse_all()") " — itself bootstrapped from " (code "parser.sx") ".")
|
||||
(li "The parsed AST is fed to " (code "PyEmitter") " and " (code "js-emit-define") " — the same bootstrappers that produced the running evaluator.")
|
||||
(li "The resulting data is rendered by SX components, written in the language " (code "eval.sx") " defines, evaluated by the runtime " (code "eval.sx") " produced.")
|
||||
(li "The components use " (code "highlight") " to syntax-highlight the SX source — which is the source of the evaluator that's currently running the highlight function."))
|
||||
(p "The evaluator evaluates its own definition. The parser parses its own grammar. The bootstrapper translates its own translator. The documentation documents the thing doing the documenting.")
|
||||
(p "This is not a metaphor. It is the literal execution path."))))
|
||||
@@ -132,7 +132,14 @@
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-green-600 text-white uppercase" "Complete")
|
||||
(a :href "/geography/isomorphism/" :class "font-semibold text-stone-800 underline" "Isomorphic Phase 7: Full Isomorphism"))
|
||||
(p :class "text-sm text-stone-600" "Affinity annotations, render plans, optimistic data updates, offline mutation queue, isomorphic testing harness, universal page descriptor.")
|
||||
(p :class "text-sm text-stone-500 mt-1" "All 6 sub-phases (7a–7f) complete."))))))
|
||||
(p :class "text-sm text-stone-500 mt-1" "All 6 sub-phases (7a–7f) complete."))
|
||||
|
||||
(div :class "rounded border border-stone-200 bg-stone-50 p-4"
|
||||
(div :class "flex items-center gap-2 mb-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded text-xs font-bold bg-stone-500 text-white uppercase" "Not Started")
|
||||
(a :href "/etc/plans/spec-explorer" :class "font-semibold text-stone-800 underline" "Spec Explorer — The Fifth Ring"))
|
||||
(p :class "text-sm text-stone-600" "SX exploring itself. Per-function cards showing all five rings: SX source (nucleus), Python/JS/Z3 translations (bootstrapper), platform dependencies (bridge), tests and proofs (runtime), and usage examples (application). The documentation is the thing documenting itself.")
|
||||
(p :class "text-sm text-stone-500 mt-1" "Prerequisite complete: 180+ functions annotated with :effects across all 14 spec files. Three increments: core + translations, bridge + runtime, examples + polish."))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Fragment Protocol
|
||||
|
||||
256
sx/sx/specs-explorer.sx
Normal file
256
sx/sx/specs-explorer.sx
Normal file
@@ -0,0 +1,256 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Spec Explorer — structured interactive view of SX spec files
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~spec-explorer-content (&key data)
|
||||
(~doc-page :title (str (get data "title") " — Explorer")
|
||||
|
||||
;; Header with filename and source link
|
||||
(~spec-explorer-header
|
||||
:filename (get data "filename")
|
||||
:title (get data "title")
|
||||
:desc (get data "desc")
|
||||
:slug (replace (get data "filename") ".sx" ""))
|
||||
|
||||
;; Stats bar
|
||||
(~spec-explorer-stats :stats (get data "stats"))
|
||||
|
||||
;; Sections
|
||||
(map (fn (section)
|
||||
(~spec-explorer-section :section section))
|
||||
(get data "sections"))
|
||||
|
||||
;; Platform interface
|
||||
(when (not (empty? (get data "platform-interface")))
|
||||
(~spec-platform-interface :items (get data "platform-interface")))))
|
||||
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Header
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~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 "/language/specs/" slug)
|
||||
:sx-get (str "/language/specs/" 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 ~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 ~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) (~spec-explorer-define :d d))
|
||||
(get section "defines")))))
|
||||
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Define card — one function/constant with all five rings
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~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) (~spec-effect-badge :effect eff))
|
||||
(get d "effects"))))
|
||||
|
||||
;; Params
|
||||
(when (not (empty? (get d "params")))
|
||||
(~spec-param-list :params (get d "params")))
|
||||
|
||||
;; Ring 2: Translation panels (SX + Python + JavaScript + Z3)
|
||||
(~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")))
|
||||
(~spec-ring-bridge :refs (get d "refs")))
|
||||
|
||||
;; Ring 4: Tests
|
||||
(when (> (get d "test-count") 0)
|
||||
(~spec-ring-runtime
|
||||
:tests (get d "tests")
|
||||
:test-count (get d "test-count")))))
|
||||
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Effect badge
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~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 ~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 ~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 ~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 ~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 ~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))))))
|
||||
172
sx/sx/specs.sx
172
sx/sx/specs.sx
@@ -12,9 +12,13 @@
|
||||
(p :class "text-lg text-stone-600"
|
||||
"SX is defined in SX. The canonical specification is a set of s-expression files that are both documentation and executable definition. Bootstrap compilers read these files to generate native implementations in JavaScript, Python, Rust, or any other target.")
|
||||
(p :class "text-stone-600"
|
||||
"The spec is split into two layers: a "
|
||||
(strong "core") " that defines the language itself, and "
|
||||
(strong "adapters") " that connect it to specific environments."))
|
||||
"The spec is organized into six sections: "
|
||||
(strong "Core") " (the language itself), "
|
||||
(strong "Adapters") " (rendering backends), "
|
||||
(strong "Browser") " (client-side runtime), "
|
||||
(strong "Reactive") " (signal system), "
|
||||
(strong "Host Interface") " (platform contract), and "
|
||||
(strong "Extensions") " (optional add-ons)."))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Core")
|
||||
@@ -96,18 +100,20 @@
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"adapter-sx.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "SX wire format")
|
||||
(td :class "px-3 py-2 text-stone-500" "Server to client"))))))
|
||||
(td :class "px-3 py-2 text-stone-500" "Server to client"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/adapter-async" :class "hover:underline"
|
||||
:sx-get "/language/specs/adapter-async" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"adapter-async.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "HTML/SX with awaited I/O")
|
||||
(td :class "px-3 py-2 text-stone-500" "Server (async)"))))))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Engine")
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Browser Runtime")
|
||||
(p :class "text-stone-600"
|
||||
"The engine is the browser-side fetch/swap/history system. It processes "
|
||||
(code :class "text-violet-700 text-sm" "sx-*")
|
||||
" attributes on elements to make HTTP requests, swap content, manage browser history, and handle events. It is split into two files: pure logic ("
|
||||
(code :class "text-violet-700 text-sm" "engine.sx")
|
||||
") and browser wiring ("
|
||||
(code :class "text-violet-700 text-sm" "orchestration.sx")
|
||||
").")
|
||||
"The browser runtime handles the full client-side lifecycle: parsing triggers, making HTTP requests, swapping content, managing history, and booting the page. Split into pure logic (engine), browser wiring (orchestration), startup (boot), and URL matching (router).")
|
||||
(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-100"
|
||||
@@ -127,16 +133,26 @@
|
||||
:sx-get "/language/specs/orchestration" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"orchestration.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Browser wiring — binds engine to DOM events, fetch, request lifecycle"))))))
|
||||
(td :class "px-3 py-2 text-stone-700" "Browser wiring — binds engine to DOM events, fetch, request lifecycle"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/boot" :class "hover:underline"
|
||||
:sx-get "/language/specs/boot" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"boot.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Browser startup — mount, hydrate, script processing, head hoisting"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/router" :class "hover:underline"
|
||||
:sx-get "/language/specs/router" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"router.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Client-side route matching — Flask-style patterns, param extraction"))))))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Browser")
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Reactive")
|
||||
(p :class "text-stone-600"
|
||||
"Browser-level support: startup lifecycle and on-demand CSS. "
|
||||
(code :class "text-violet-700 text-sm" "boot.sx")
|
||||
" handles page load — processing scripts, mounting content, and hydrating elements. "
|
||||
(code :class "text-violet-700 text-sm" "cssx.sx")
|
||||
" provides the on-demand CSS system that resolves keyword atoms into class names and injects rules as needed.")
|
||||
"Fine-grained reactive primitives for client-side islands. Signals notify subscribers on change, computed values derive lazily, effects run side-effects with cleanup, and batch coalesces updates.")
|
||||
(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-100"
|
||||
@@ -145,45 +161,80 @@
|
||||
(tbody
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/boot" :class "hover:underline"
|
||||
:sx-get "/language/specs/boot" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
(a :href "/language/specs/signals" :class "hover:underline"
|
||||
:sx-get "/language/specs/signals" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"boot.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Browser startup lifecycle — mount, hydrate, script processing, head hoisting"))
|
||||
"signals.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Signal runtime — signal, deref, reset!, swap!, computed, effect, batch, island scope"))))))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Host Interface")
|
||||
(p :class "text-stone-600"
|
||||
"The contract between SX and its host environment. Boundary declares what the host must provide. Forms define server-side application constructs. Page helpers offer pure data transformations for rendering.")
|
||||
(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-100"
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "File")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Role")))
|
||||
(tbody
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/cssx" :class "hover:underline"
|
||||
:sx-get "/language/specs/cssx" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
(a :href "/language/specs/boundary" :class "hover:underline"
|
||||
:sx-get "/language/specs/boundary" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"cssx.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "On-demand CSS — style dictionary, keyword resolution, rule injection"))))))
|
||||
"boundary.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Language boundary — I/O primitives, page helpers, tier declarations"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/forms" :class "hover:underline"
|
||||
:sx-get "/language/specs/forms" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"forms.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Definition forms — defhandler, defquery, defaction, defpage"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/page-helpers" :class "hover:underline"
|
||||
:sx-get "/language/specs/page-helpers" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"page-helpers.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Pure data-transformation helpers for page rendering"))))))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Dependency graph")
|
||||
(div :class "not-prose bg-stone-100 rounded-lg p-5 mx-auto max-w-3xl"
|
||||
(pre :class "text-sm leading-relaxed whitespace-pre-wrap break-words font-mono text-stone-700"
|
||||
"parser.sx (standalone — no dependencies)
|
||||
";; Core
|
||||
parser.sx (standalone — no dependencies)
|
||||
primitives.sx (standalone — declarative registry)
|
||||
special-forms.sx (standalone — declarative registry)
|
||||
eval.sx depends on: parser, primitives, special-forms
|
||||
render.sx (standalone — shared registries)
|
||||
|
||||
;; Adapters
|
||||
adapter-dom.sx depends on: render, eval
|
||||
adapter-html.sx depends on: render, eval
|
||||
adapter-sx.sx depends on: render, eval
|
||||
adapter-async.sx depends on: adapter-html, adapter-sx, eval
|
||||
|
||||
;; Browser Runtime
|
||||
engine.sx depends on: eval, adapter-dom
|
||||
orchestration.sx depends on: engine, adapter-dom
|
||||
cssx.sx depends on: render
|
||||
boot.sx depends on: cssx, orchestration, adapter-dom, render
|
||||
boot.sx depends on: orchestration, adapter-dom, render
|
||||
router.sx (standalone — pure string/list ops)
|
||||
|
||||
;; Extensions (optional — loaded only when target requests them)
|
||||
continuations.sx depends on: eval (optional)
|
||||
callcc.sx depends on: eval (optional)
|
||||
;; Reactive
|
||||
signals.sx depends on: eval
|
||||
|
||||
;; Spec modules (optional — loaded via --spec-modules)
|
||||
deps.sx depends on: eval (optional)
|
||||
router.sx (standalone — pure string/list ops)")))
|
||||
;; Host Interface
|
||||
boundary.sx (standalone — declarative contract)
|
||||
forms.sx depends on: eval
|
||||
page-helpers.sx (standalone — declarative registry)
|
||||
|
||||
;; Extensions (optional)
|
||||
continuations.sx depends on: eval
|
||||
callcc.sx depends on: eval
|
||||
types.sx depends on: eval, primitives
|
||||
deps.sx depends on: eval")))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Extensions")
|
||||
@@ -193,8 +244,7 @@ router.sx (standalone — pure string/list ops)")))
|
||||
(table :class "w-full text-left text-sm"
|
||||
(thead (tr :class "border-b border-stone-200 bg-stone-100"
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "File")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Role")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Recommended targets")))
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Role")))
|
||||
(tbody
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
@@ -202,16 +252,28 @@ router.sx (standalone — pure string/list ops)")))
|
||||
:sx-get "/language/specs/continuations" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"continuations.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Delimited continuations — shift/reset")
|
||||
(td :class "px-3 py-2 text-stone-500" "All targets"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Delimited continuations — shift/reset"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/callcc" :class "hover:underline"
|
||||
:sx-get "/language/specs/callcc" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"callcc.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Full first-class continuations — call/cc")
|
||||
(td :class "px-3 py-2 text-stone-500" "Scheme, Haskell"))))))
|
||||
(td :class "px-3 py-2 text-stone-700" "Full first-class continuations — call/cc"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/types" :class "hover:underline"
|
||||
:sx-get "/language/specs/types" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"types.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Gradual type system — registration-time checking, zero runtime cost"))
|
||||
(tr :class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 font-mono text-sm text-violet-700"
|
||||
(a :href "/language/specs/deps" :class "hover:underline"
|
||||
:sx-get "/language/specs/deps" :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true"
|
||||
"deps.sx"))
|
||||
(td :class "px-3 py-2 text-stone-700" "Component dependency analysis — bundling, IO detection, CSS scoping"))))))
|
||||
|
||||
(div :class "space-y-3"
|
||||
(h2 :class "text-2xl font-semibold text-stone-800" "Self-hosting")
|
||||
@@ -235,11 +297,17 @@ router.sx (standalone — pure string/list ops)")))
|
||||
(p :class "text-stone-600 mb-6"
|
||||
(case spec-title
|
||||
"Core Language"
|
||||
"The core specification defines the language itself — parsing, evaluation, primitives, and shared rendering definitions. These four files are platform-independent and sufficient to implement SX on any target."
|
||||
"Adapters & Engine"
|
||||
"Adapters connect the core language to specific environments. Each adapter takes evaluated expression trees and produces output for its target. The engine adds browser-side fetch/swap behaviour, split into pure logic and browser orchestration."
|
||||
"Browser"
|
||||
"Browser-level support: the startup lifecycle that boots SX in the browser, and the on-demand CSS system that resolves keyword atoms into Tailwind-compatible class names."
|
||||
"The core specification defines the language itself — parsing, evaluation, primitives, special forms, and shared rendering definitions. These five files are platform-independent and sufficient to implement SX on any target."
|
||||
"Adapters"
|
||||
"Adapters connect the core language to specific environments. Each adapter takes evaluated expression trees and produces output for its target — DOM nodes, HTML strings, SX wire format, or async-aware server rendering."
|
||||
"Browser Runtime"
|
||||
"The browser runtime handles the client-side lifecycle: parsing triggers, making requests, swapping content, managing history, and booting the page. Split into pure logic (engine), browser wiring (orchestration), startup (boot), and URL matching (router)."
|
||||
"Reactive System"
|
||||
"Fine-grained reactive primitives for client-side islands. Signals, computed values, effects, and batching — the reactive graph that powers L2-L3 interactivity without a virtual DOM."
|
||||
"Host Interface"
|
||||
"The contract between SX and its host environment. Boundary declarations specify what the host must provide, forms define server-side application constructs, and page helpers offer pure data transformations."
|
||||
"Extensions"
|
||||
"Optional bolt-on specifications that extend the core language. Bootstrappers include them only when the target requests them. Code that doesn't use extensions pays zero cost."
|
||||
:else ""))
|
||||
(div :class "space-y-8"
|
||||
(map (fn (spec)
|
||||
@@ -266,9 +334,15 @@ router.sx (standalone — pure string/list ops)")))
|
||||
|
||||
(defcomp ~spec-detail-content (&key (spec-title :as string) (spec-desc :as string) (spec-filename :as string) (spec-source :as string) (spec-prose :as string?))
|
||||
(~doc-page :title spec-title
|
||||
(div :class "flex items-baseline gap-3 mb-4"
|
||||
(div :class "flex items-center gap-3 mb-4"
|
||||
(span :class "text-sm text-stone-400 font-mono" spec-filename)
|
||||
(span :class "text-sm text-stone-500" spec-desc))
|
||||
(span :class "text-sm text-stone-500 flex-1" spec-desc)
|
||||
(a :href (str "/language/specs/explore/" (replace spec-filename ".sx" ""))
|
||||
:sx-get (str "/language/specs/explore/" (replace spec-filename ".sx" ""))
|
||||
: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 whitespace-nowrap"
|
||||
"Explore"))
|
||||
(when spec-prose
|
||||
(div :class "mb-6 space-y-3"
|
||||
(p :class "text-stone-600 leading-relaxed" spec-prose)
|
||||
|
||||
@@ -1,367 +0,0 @@
|
||||
;; SX example API handlers — defhandler definitions
|
||||
;;
|
||||
;; These serve the live demos on the Examples docs pages.
|
||||
;; Each handler's source is displayed in the "Server handler" code block
|
||||
;; on its corresponding example page (self-referencing via handler-source).
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Click to Load
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler click (&key)
|
||||
(let ((now (format-time (now) "%H:%M:%S")))
|
||||
(~click-result :time now)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Form Submission
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler form (&key)
|
||||
(let ((name (form-data "name")))
|
||||
(~form-result :name name)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Polling
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler poll (&key)
|
||||
(let ((now (format-time (now) "%H:%M:%S"))
|
||||
(count (inc-counter "poll" :max 10)))
|
||||
(~poll-result :time now :count count)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Delete Row
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler delete (&key item-id)
|
||||
;; Empty response — outerHTML swap removes the row
|
||||
"")
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Inline Edit
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler edit-form (&key)
|
||||
(let ((value (request-arg "value")))
|
||||
(~inline-edit-form :value value)))
|
||||
|
||||
(defhandler edit-save (&key)
|
||||
(let ((value (form-data "value")))
|
||||
(~inline-view :value value)))
|
||||
|
||||
(defhandler edit-cancel (&key)
|
||||
(let ((value (request-arg "value")))
|
||||
(~inline-view :value value)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Out-of-Band Swaps
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler oob (&key)
|
||||
(let ((now (format-time (now) "%H:%M:%S")))
|
||||
(<>
|
||||
(p :class "text-emerald-600 font-medium" "Box A updated!")
|
||||
(p :class "text-sm text-stone-500" "at " now)
|
||||
(div :id "oob-box-b" :sx-swap-oob "innerHTML"
|
||||
(p :class "text-violet-600 font-medium" "Box B updated via OOB!")
|
||||
(p :class "text-sm text-stone-500" "at " now)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Lazy Loading
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler lazy (&key)
|
||||
(let ((now (format-time (now) "%H:%M:%S")))
|
||||
(~lazy-result :time now)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Infinite Scroll
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler scroll (&key)
|
||||
(let ((page (or (parse-int (request-arg "page")) 2))
|
||||
(start (+ (* (- page 1) 5) 1))
|
||||
(next (+ page 1)))
|
||||
(<>
|
||||
(map (fn (i)
|
||||
(div :class "px-4 py-3 border-b border-stone-100 text-sm text-stone-700"
|
||||
"Item " i " — loaded from page " page))
|
||||
(range start (+ start 5)))
|
||||
(if (<= next 6)
|
||||
(div :id "scroll-sentinel"
|
||||
:sx-get (str "/geography/hypermedia/examples/api/scroll?page=" next)
|
||||
:sx-trigger "intersect once"
|
||||
:sx-target "#scroll-items"
|
||||
:sx-swap "beforeend"
|
||||
:class "p-3 text-center text-stone-400 text-sm"
|
||||
"Loading more...")
|
||||
(div :class "p-3 text-center text-stone-500 text-sm font-medium"
|
||||
"All items loaded.")))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Progress Bar
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler progress-start (&key)
|
||||
(let ((job-id (new-job)))
|
||||
(~progress-status :percent 0 :job-id job-id)))
|
||||
|
||||
(defhandler progress-status (&key)
|
||||
(let ((job-id (request-arg "job"))
|
||||
(percent (advance-job job-id)))
|
||||
(~progress-status :percent percent :job-id job-id)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Active Search
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler search (&key)
|
||||
(let ((q (request-arg "q"))
|
||||
(results (filter-list LANGUAGES q)))
|
||||
(~search-results :items results :query q)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Inline Validation
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler validate (&key)
|
||||
(let ((email (request-arg "email")))
|
||||
(cond
|
||||
((not email)
|
||||
(~validation-error :message "Email is required"))
|
||||
((not (contains? email "@"))
|
||||
(~validation-error :message "Invalid email format"))
|
||||
((contains? TAKEN_EMAILS (lower email))
|
||||
(~validation-error
|
||||
:message (str email " is already taken")))
|
||||
(t (~validation-ok :email email)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Value Select
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler values (&key)
|
||||
(let ((cat (request-arg "category"))
|
||||
(items (get VALUE_SELECT_DATA cat)))
|
||||
(if (empty? items)
|
||||
(option :value "" "No items")
|
||||
(map (fn (i) (option :value i i)) items))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Reset on Submit
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler reset-submit (&key)
|
||||
(let ((msg (or (form-data "message") "(empty)"))
|
||||
(now (format-time (now) "%H:%M:%S")))
|
||||
(~reset-message :message msg :time now)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Edit Row
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler editrow-form (&key row-id)
|
||||
(let ((row (get ROWS row-id)))
|
||||
(~edit-row-form :id row-id
|
||||
:name (get row "name")
|
||||
:price (get row "price")
|
||||
:stock (get row "stock"))))
|
||||
|
||||
(defhandler editrow-save (&key row-id)
|
||||
(let ((name (form-data "name"))
|
||||
(price (form-data "price"))
|
||||
(stock (form-data "stock")))
|
||||
(~edit-row-view :id row-id
|
||||
:name name :price price :stock stock)))
|
||||
|
||||
(defhandler editrow-cancel (&key row-id)
|
||||
(let ((row (get ROWS row-id)))
|
||||
(~edit-row-view :id row-id
|
||||
:name (get row "name")
|
||||
:price (get row "price")
|
||||
:stock (get row "stock"))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Bulk Update
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler bulk (&key)
|
||||
(let ((action (request-arg "action"))
|
||||
(ids (form-list "ids"))
|
||||
(status (if (= action "activate")
|
||||
"active" "inactive")))
|
||||
(update-users ids :status status)
|
||||
(map (fn (u)
|
||||
(~bulk-row
|
||||
:id (get u "id")
|
||||
:name (get u "name")
|
||||
:email (get u "email")
|
||||
:status (get u "status")))
|
||||
USERS)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Swap Positions
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler swap-log (&key)
|
||||
(let ((mode (request-arg "mode"))
|
||||
(n (inc-counter "swap"))
|
||||
(now (format-time (now) "%H:%M:%S")))
|
||||
(<>
|
||||
(div :class "px-3 py-2 text-sm text-stone-700"
|
||||
"[" now "] " mode " (#" n ")")
|
||||
(span :id "swap-counter"
|
||||
:sx-swap-oob "innerHTML"
|
||||
:class "self-center text-sm text-stone-500"
|
||||
"Count: " n))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Select Filter (Dashboard)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler dashboard (&key)
|
||||
(let ((now (format-time (now) "%H:%M:%S")))
|
||||
(<>
|
||||
(div :id "dash-header" :class "p-3 bg-violet-50 rounded mb-3"
|
||||
(h4 :class "font-semibold text-violet-800" "Dashboard Header")
|
||||
(p :class "text-sm text-violet-600" "Generated at " now))
|
||||
(div :id "dash-stats" :class "grid grid-cols-3 gap-3 mb-3"
|
||||
(div :class "p-3 bg-emerald-50 rounded text-center"
|
||||
(p :class "text-2xl font-bold text-emerald-700" "142")
|
||||
(p :class "text-xs text-emerald-600" "Users"))
|
||||
(div :class "p-3 bg-blue-50 rounded text-center"
|
||||
(p :class "text-2xl font-bold text-blue-700" "89")
|
||||
(p :class "text-xs text-blue-600" "Orders"))
|
||||
(div :class "p-3 bg-amber-50 rounded text-center"
|
||||
(p :class "text-2xl font-bold text-amber-700" "$4.2k")
|
||||
(p :class "text-xs text-amber-600" "Revenue")))
|
||||
(div :id "dash-footer" :class "p-3 bg-stone-100 rounded"
|
||||
(p :class "text-sm text-stone-500" "Last updated: " now)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Tabs
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler tabs (&key tab)
|
||||
(let ((content (get TAB_CONTENT tab)))
|
||||
(<> content
|
||||
(div :id "tab-buttons"
|
||||
:sx-swap-oob "innerHTML"
|
||||
:class "flex border-b border-stone-200"
|
||||
(map (fn (t)
|
||||
(~tab-btn
|
||||
:tab (first t)
|
||||
:label (last t)
|
||||
:active (if (= (first t) tab) "true" "false")))
|
||||
TAB_LIST)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Animations
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler animate (&key)
|
||||
(let ((color (random-choice
|
||||
"bg-violet-100" "bg-emerald-100"
|
||||
"bg-blue-100" "bg-amber-100"))
|
||||
(now (format-time (now) "%H:%M:%S")))
|
||||
(~anim-result :color color :time now)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Dialogs
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler dialog (&key)
|
||||
(~dialog-modal
|
||||
:title "Confirm Action"
|
||||
:message "Are you sure you want to proceed?"))
|
||||
|
||||
(defhandler dialog-close (&key)
|
||||
"")
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Keyboard Shortcuts
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler keyboard (&key)
|
||||
(let ((key (request-arg "key"))
|
||||
(actions {:s "Search panel activated"
|
||||
:n "New item created"
|
||||
:h "Help panel opened"})
|
||||
(action (get actions key)))
|
||||
(~kbd-result :key key :action action)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; PUT / PATCH
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler pp-edit-all (&key)
|
||||
(let ((p (get-profile)))
|
||||
(~pp-form-full
|
||||
:name (get p "name")
|
||||
:email (get p "email")
|
||||
:role (get p "role"))))
|
||||
|
||||
(defhandler put-profile (&key)
|
||||
(let ((name (form-data "name"))
|
||||
(email (form-data "email"))
|
||||
(role (form-data "role")))
|
||||
(~pp-view :name name :email email :role role)))
|
||||
|
||||
(defhandler pp-cancel (&key)
|
||||
(let ((p (get-profile)))
|
||||
(~pp-view
|
||||
:name (get p "name")
|
||||
:email (get p "email")
|
||||
:role (get p "role"))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; JSON Encoding
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler json-echo (&key)
|
||||
(let ((data (request-json))
|
||||
(body (json-pretty data))
|
||||
(ct (request-header "content-type")))
|
||||
(~json-result :body body :content-type ct)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Vals & Headers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler echo-vals (&key)
|
||||
(let ((vals (request-args)))
|
||||
(~echo-result :label "values" :items vals)))
|
||||
|
||||
(defhandler echo-headers (&key)
|
||||
(let ((headers (request-headers :prefix "X-")))
|
||||
(~echo-result :label "headers" :items headers)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Loading States
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler slow (&key)
|
||||
(sleep 2000)
|
||||
(let ((now (format-time (now) "%H:%M:%S")))
|
||||
(~loading-result :time now)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Request Abort (sync replace)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler slow-search (&key)
|
||||
(let ((delay (random-int 500 2000)))
|
||||
(sleep delay)
|
||||
(let ((q (request-arg "q")))
|
||||
(~sync-result :query q :delay delay))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Retry
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defhandler flaky (&key)
|
||||
(let ((n (inc-counter "flaky")))
|
||||
(if (!= (mod n 3) 0)
|
||||
(error 503)
|
||||
(~retry-result :attempt n
|
||||
:message "Success! The endpoint finally responded."))))
|
||||
@@ -258,6 +258,7 @@
|
||||
"zero-tooling" (~essay-zero-tooling)
|
||||
"react-is-hypermedia" (~essay-react-is-hypermedia)
|
||||
"hegelian-synthesis" (~essay-hegelian-synthesis)
|
||||
"the-art-chain" (~essay-the-art-chain)
|
||||
:else (~essays-index-content))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
@@ -322,39 +323,32 @@
|
||||
:auth :public
|
||||
:layout :sx-docs
|
||||
:content (~sx-doc :path (str "/language/specs/" slug)
|
||||
(let ((make-spec-files (fn (items)
|
||||
(map (fn (item)
|
||||
(dict :title (get item "title") :desc (get item "desc")
|
||||
:prose (get item "prose")
|
||||
:filename (get item "filename") :href (str "/language/specs/" (get item "slug"))
|
||||
:source (read-spec-file (get item "filename"))))
|
||||
items))))
|
||||
(case slug
|
||||
"core" (~spec-overview-content
|
||||
:spec-title "Core Language"
|
||||
:spec-files (map (fn (item)
|
||||
(dict :title (get item "title") :desc (get item "desc")
|
||||
:prose (get item "prose")
|
||||
:filename (get item "filename") :href (str "/language/specs/" (get item "slug"))
|
||||
:source (read-spec-file (get item "filename"))))
|
||||
core-spec-items))
|
||||
:spec-files (make-spec-files core-spec-items))
|
||||
"adapters" (~spec-overview-content
|
||||
:spec-title "Adapters & Engine"
|
||||
:spec-files (map (fn (item)
|
||||
(dict :title (get item "title") :desc (get item "desc")
|
||||
:prose (get item "prose")
|
||||
:filename (get item "filename") :href (str "/language/specs/" (get item "slug"))
|
||||
:source (read-spec-file (get item "filename"))))
|
||||
adapter-spec-items))
|
||||
:spec-title "Adapters"
|
||||
:spec-files (make-spec-files adapter-spec-items))
|
||||
"browser" (~spec-overview-content
|
||||
:spec-title "Browser"
|
||||
:spec-files (map (fn (item)
|
||||
(dict :title (get item "title") :desc (get item "desc")
|
||||
:prose (get item "prose")
|
||||
:filename (get item "filename") :href (str "/language/specs/" (get item "slug"))
|
||||
:source (read-spec-file (get item "filename"))))
|
||||
browser-spec-items))
|
||||
:spec-title "Browser Runtime"
|
||||
:spec-files (make-spec-files browser-spec-items))
|
||||
"reactive" (~spec-overview-content
|
||||
:spec-title "Reactive System"
|
||||
:spec-files (make-spec-files reactive-spec-items))
|
||||
"host" (~spec-overview-content
|
||||
:spec-title "Host Interface"
|
||||
:spec-files (make-spec-files host-spec-items))
|
||||
"extensions" (~spec-overview-content
|
||||
:spec-title "Extensions"
|
||||
:spec-files (map (fn (item)
|
||||
(dict :title (get item "title") :desc (get item "desc")
|
||||
:prose (get item "prose")
|
||||
:filename (get item "filename") :href (str "/language/specs/" (get item "slug"))
|
||||
:source (read-spec-file (get item "filename"))))
|
||||
extension-spec-items))
|
||||
:spec-files (make-spec-files extension-spec-items))
|
||||
:else (let ((spec (find-spec slug)))
|
||||
(if spec
|
||||
(~spec-detail-content
|
||||
@@ -363,7 +357,27 @@
|
||||
:spec-filename (get spec "filename")
|
||||
:spec-source (read-spec-file (get spec "filename"))
|
||||
:spec-prose (get spec "prose"))
|
||||
(~spec-not-found :slug slug))))))
|
||||
(~spec-not-found :slug slug)))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Spec Explorer — structured interactive view of spec files
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defpage specs-explore-page
|
||||
:path "/language/specs/explore/<slug>"
|
||||
:auth :public
|
||||
:layout :sx-docs
|
||||
:content (~sx-doc :path (str "/language/specs/explore/" slug)
|
||||
(let ((spec (find-spec slug)))
|
||||
(if spec
|
||||
(let ((data (spec-explorer-data
|
||||
(get spec "filename")
|
||||
(get spec "title")
|
||||
(get spec "desc"))))
|
||||
(if data
|
||||
(~spec-explorer-content :data data)
|
||||
(~spec-not-found :slug slug)))
|
||||
(~spec-not-found :slug slug)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Bootstrappers section
|
||||
@@ -557,6 +571,7 @@
|
||||
"wasm-bytecode-vm" (~plan-wasm-bytecode-vm-content)
|
||||
"generative-sx" (~plan-generative-sx-content)
|
||||
"art-dag-sx" (~plan-art-dag-sx-content)
|
||||
"spec-explorer" (~plan-spec-explorer-content)
|
||||
:else (~plans-index-content))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
@@ -34,6 +34,8 @@ def _register_sx_helpers() -> None:
|
||||
"offline-demo-data": _offline_demo_data,
|
||||
"prove-data": _prove_data,
|
||||
"page-helpers-demo-data": _page_helpers_demo_data,
|
||||
"spec-explorer-data": _spec_explorer_data,
|
||||
"handler-source": _handler_source,
|
||||
})
|
||||
|
||||
|
||||
@@ -67,6 +69,35 @@ def _component_source(name: str) -> str:
|
||||
})
|
||||
|
||||
|
||||
def _handler_source(name: str) -> str:
|
||||
"""Return the pretty-printed defhandler source for a named handler."""
|
||||
from shared.sx.handlers import get_handler
|
||||
from shared.sx.parser import serialize
|
||||
|
||||
hdef = get_handler("sx", name)
|
||||
if not hdef:
|
||||
return f";;; Handler not found: {name}"
|
||||
|
||||
parts = [f"(defhandler {hdef.name}"]
|
||||
if hdef.path:
|
||||
parts.append(f' :path "{hdef.path}"')
|
||||
if hdef.method != "get":
|
||||
parts.append(f" :method :{hdef.method}")
|
||||
if not hdef.csrf:
|
||||
parts.append(" :csrf false")
|
||||
if hdef.returns != "element":
|
||||
parts.append(f' :returns "{hdef.returns}"')
|
||||
param_strs = ["&key"] + list(hdef.params) if hdef.params else []
|
||||
parts.append(f" ({' '.join(param_strs)})" if param_strs else " ()")
|
||||
body_sx = serialize(hdef.body, pretty=True)
|
||||
# Indent body by 2 spaces
|
||||
body_lines = body_sx.split("\n")
|
||||
parts.append(" " + body_lines[0])
|
||||
for line in body_lines[1:]:
|
||||
parts.append(" " + line)
|
||||
return "\n".join(parts) + ")"
|
||||
|
||||
|
||||
def _primitives_data() -> dict:
|
||||
"""Return the PRIMITIVES dict for the primitives docs page."""
|
||||
from content.pages import PRIMITIVES
|
||||
@@ -141,6 +172,478 @@ def _read_spec_file(filename: str) -> str:
|
||||
return ";; spec file not found"
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Spec explorer — translation + cross-reference helpers
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
_JS_SX_ENV = None # cached js.sx evaluator env
|
||||
|
||||
def _js_translate_define(expr: list, name: str) -> str | None:
|
||||
"""Translate a single define expression to JavaScript via js.sx."""
|
||||
global _JS_SX_ENV
|
||||
if _JS_SX_ENV is None:
|
||||
from shared.sx.ref.run_js_sx import load_js_sx
|
||||
_JS_SX_ENV = load_js_sx()
|
||||
from shared.sx.ref.sx_ref import evaluate
|
||||
from shared.sx.types import Symbol
|
||||
env = dict(_JS_SX_ENV)
|
||||
env["_defines"] = [[name, expr]]
|
||||
result = evaluate([Symbol("js-translate-file"), Symbol("_defines")], env)
|
||||
if result and isinstance(result, str) and result.strip():
|
||||
return result.strip()
|
||||
return None
|
||||
|
||||
|
||||
def _z3_translate_define(expr: list) -> str | None:
|
||||
"""Translate a single define expression to SMT-LIB via z3.sx."""
|
||||
from shared.sx.ref.reader_z3 import z3_translate
|
||||
result = z3_translate(expr)
|
||||
if result and isinstance(result, str) and result.strip():
|
||||
return result.strip()
|
||||
return None
|
||||
|
||||
|
||||
_SPEC_INDEX: dict[str, str] | None = None # function name → spec slug
|
||||
|
||||
def _build_spec_index() -> dict[str, str]:
|
||||
"""Build a global index mapping function names to spec file slugs."""
|
||||
global _SPEC_INDEX
|
||||
if _SPEC_INDEX is not None:
|
||||
return _SPEC_INDEX
|
||||
|
||||
import os
|
||||
import glob as globmod
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol, Keyword
|
||||
|
||||
ref_dir = os.path.join(os.path.dirname(__file__), "..", "..", "shared", "sx", "ref")
|
||||
if not os.path.isdir(ref_dir):
|
||||
ref_dir = "/app/shared/sx/ref"
|
||||
|
||||
index: dict[str, str] = {}
|
||||
for fp in globmod.glob(os.path.join(ref_dir, "*.sx")):
|
||||
basename = os.path.basename(fp)
|
||||
if basename.startswith("test-"):
|
||||
continue
|
||||
slug = basename.replace(".sx", "")
|
||||
try:
|
||||
with open(fp, encoding="utf-8") as f:
|
||||
content = f.read()
|
||||
for expr in parse_all(content):
|
||||
if not isinstance(expr, list) or len(expr) < 2:
|
||||
continue
|
||||
if not isinstance(expr[0], Symbol):
|
||||
continue
|
||||
head = expr[0].name
|
||||
if head in ("define", "define-async"):
|
||||
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
|
||||
index[name] = slug
|
||||
except Exception:
|
||||
continue
|
||||
|
||||
_SPEC_INDEX = index
|
||||
return _SPEC_INDEX
|
||||
|
||||
|
||||
# Test file → spec file mapping
|
||||
_SPEC_TO_TEST = {
|
||||
"signals.sx": "test-signals.sx",
|
||||
"eval.sx": "test-eval.sx",
|
||||
"parser.sx": "test-parser.sx",
|
||||
"render.sx": "test-render.sx",
|
||||
"engine.sx": "test-engine.sx",
|
||||
"orchestration.sx": "test-orchestration.sx",
|
||||
"router.sx": "test-router.sx",
|
||||
"deps.sx": "test-deps.sx",
|
||||
"adapter-sx.sx": "test-aser.sx",
|
||||
"types.sx": "test-types.sx",
|
||||
}
|
||||
|
||||
|
||||
def _extract_tests_for_spec(filename: str) -> list[dict]:
|
||||
"""Extract test suites/cases from the corresponding test file."""
|
||||
import os
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol
|
||||
|
||||
test_file = _SPEC_TO_TEST.get(filename)
|
||||
if not test_file:
|
||||
return []
|
||||
|
||||
ref_dir = os.path.join(os.path.dirname(__file__), "..", "..", "shared", "sx", "ref")
|
||||
if not os.path.isdir(ref_dir):
|
||||
ref_dir = "/app/shared/sx/ref"
|
||||
test_path = os.path.join(ref_dir, test_file)
|
||||
|
||||
try:
|
||||
with open(test_path, encoding="utf-8") as f:
|
||||
content = f.read()
|
||||
exprs = parse_all(content)
|
||||
except Exception:
|
||||
return []
|
||||
|
||||
tests: list[dict] = []
|
||||
for expr in exprs:
|
||||
if not isinstance(expr, list) or len(expr) < 3:
|
||||
continue
|
||||
if not isinstance(expr[0], Symbol):
|
||||
continue
|
||||
if expr[0].name != "defsuite":
|
||||
continue
|
||||
suite_name = expr[1] if isinstance(expr[1], str) else str(expr[1])
|
||||
test_names = []
|
||||
for child in expr[2:]:
|
||||
if isinstance(child, list) and len(child) >= 2:
|
||||
if isinstance(child[0], Symbol) and child[0].name == "deftest":
|
||||
tname = child[1] if isinstance(child[1], str) else str(child[1])
|
||||
test_names.append(tname)
|
||||
tests.append({"suite": suite_name, "tests": test_names})
|
||||
return tests
|
||||
|
||||
|
||||
def _match_tests_to_function(fn_name: str, all_tests: list[dict]) -> list[dict]:
|
||||
"""Match test suites to a function by fuzzy name matching."""
|
||||
matched = []
|
||||
fn_lower = fn_name.lower().replace("-", " ").replace("!", "").replace("?", "")
|
||||
fn_words = set(fn_lower.split())
|
||||
for suite in all_tests:
|
||||
suite_lower = suite["suite"].lower()
|
||||
# Match if function name appears in suite name or suite name contains function
|
||||
if fn_lower in suite_lower or any(w in suite_lower for w in fn_words if len(w) > 2):
|
||||
matched.append(suite)
|
||||
return matched
|
||||
|
||||
|
||||
def _collect_symbols(expr) -> set[str]:
|
||||
"""Recursively collect all Symbol names referenced in an expression."""
|
||||
from shared.sx.types import Symbol
|
||||
result: set[str] = set()
|
||||
if isinstance(expr, Symbol):
|
||||
result.add(expr.name)
|
||||
elif isinstance(expr, list):
|
||||
for item in expr:
|
||||
result |= _collect_symbols(item)
|
||||
elif isinstance(expr, dict):
|
||||
for v in expr.values():
|
||||
result |= _collect_symbols(v)
|
||||
return result
|
||||
|
||||
|
||||
def _spec_explorer_data(filename: str, title: str = "", desc: str = "") -> dict | None:
|
||||
"""Parse a spec file into structured metadata for the spec explorer.
|
||||
|
||||
Receives filename/title/desc from the SX routing layer (via find-spec).
|
||||
Returns sections with defines, effects, params, source, and translations.
|
||||
"""
|
||||
import os
|
||||
import re
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.types import Symbol, Keyword
|
||||
|
||||
if not filename:
|
||||
return None
|
||||
|
||||
# Read the raw source
|
||||
ref_dir = os.path.join(os.path.dirname(__file__), "..", "..", "shared", "sx", "ref")
|
||||
if not os.path.isdir(ref_dir):
|
||||
ref_dir = "/app/shared/sx/ref"
|
||||
filepath = os.path.join(ref_dir, filename)
|
||||
try:
|
||||
with open(filepath, encoding="utf-8") as f:
|
||||
source = f.read()
|
||||
except FileNotFoundError:
|
||||
return None
|
||||
|
||||
lines = source.split("\n")
|
||||
|
||||
# --- 1. Section splitting ---
|
||||
sections: list[dict] = []
|
||||
current_section: dict | None = None
|
||||
i = 0
|
||||
while i < len(lines):
|
||||
line = lines[i]
|
||||
# Detect section dividers: ;; ---...
|
||||
if re.match(r"^;; -{10,}", line):
|
||||
# Look for title in following comment lines
|
||||
title_lines = []
|
||||
j = i + 1
|
||||
while j < len(lines) and lines[j].startswith(";;"):
|
||||
content = lines[j][2:].strip()
|
||||
if re.match(r"^-{10,}", content):
|
||||
j += 1
|
||||
break
|
||||
if content:
|
||||
title_lines.append(content)
|
||||
j += 1
|
||||
if title_lines:
|
||||
section_title = title_lines[0]
|
||||
# Collect comment block after section header
|
||||
comment_lines = []
|
||||
k = j
|
||||
while k < len(lines) and lines[k].startswith(";;"):
|
||||
c = lines[k][2:].strip()
|
||||
if re.match(r"^-{5,}", c) or re.match(r"^={5,}", c):
|
||||
break
|
||||
if c:
|
||||
comment_lines.append(c)
|
||||
k += 1
|
||||
current_section = {
|
||||
"title": section_title,
|
||||
"comment": " ".join(comment_lines) if comment_lines else None,
|
||||
"defines": [],
|
||||
}
|
||||
sections.append(current_section)
|
||||
i = j
|
||||
continue
|
||||
i += 1
|
||||
|
||||
# If no sections found, create a single implicit one
|
||||
if not sections:
|
||||
current_section = {"title": filename, "comment": None, "defines": []}
|
||||
sections.append(current_section)
|
||||
|
||||
# --- 2. Parse AST ---
|
||||
try:
|
||||
exprs = parse_all(source)
|
||||
except Exception:
|
||||
exprs = []
|
||||
|
||||
# --- 3. Process each top-level define ---
|
||||
# Build a line-number index: find where each top-level form starts
|
||||
def _find_source_block(name: str, form: str = "define") -> tuple[str, int]:
|
||||
"""Find the source text of a define form by scanning raw source."""
|
||||
patterns = [
|
||||
f"({form} {name} ",
|
||||
f"({form} {name}\n",
|
||||
]
|
||||
for pat in patterns:
|
||||
idx = source.find(pat)
|
||||
if idx >= 0:
|
||||
# Count balanced parens from idx
|
||||
depth = 0
|
||||
end = idx
|
||||
for ci, ch in enumerate(source[idx:], idx):
|
||||
if ch == "(":
|
||||
depth += 1
|
||||
elif ch == ")":
|
||||
depth -= 1
|
||||
if depth == 0:
|
||||
end = ci + 1
|
||||
break
|
||||
line_num = source[:idx].count("\n") + 1
|
||||
return source[idx:end], line_num
|
||||
return "", 0
|
||||
|
||||
def _extract_effects(expr: list) -> list[str]:
|
||||
"""Extract :effects [...] from a define form."""
|
||||
if len(expr) >= 4 and isinstance(expr[2], Keyword) and expr[2].name == "effects":
|
||||
eff_list = expr[3]
|
||||
if isinstance(eff_list, list):
|
||||
return [s.name if isinstance(s, Symbol) else str(s) for s in eff_list]
|
||||
return []
|
||||
|
||||
def _extract_params(expr: list) -> list[dict]:
|
||||
"""Extract params from the fn/lambda body of a define."""
|
||||
# Find the fn/lambda form
|
||||
val_expr = expr[4] if (len(expr) >= 5 and isinstance(expr[2], Keyword)
|
||||
and expr[2].name == "effects") else expr[2] if len(expr) >= 3 else None
|
||||
if not isinstance(val_expr, list) or not val_expr:
|
||||
return []
|
||||
if not isinstance(val_expr[0], Symbol):
|
||||
return []
|
||||
if val_expr[0].name not in ("fn", "lambda"):
|
||||
return []
|
||||
if len(val_expr) < 2 or not isinstance(val_expr[1], list):
|
||||
return []
|
||||
params_list = val_expr[1]
|
||||
result = []
|
||||
i = 0
|
||||
while i < len(params_list):
|
||||
p = params_list[i]
|
||||
if isinstance(p, Symbol) and p.name in ("&rest", "&key"):
|
||||
result.append({"name": p.name, "type": None})
|
||||
i += 1
|
||||
continue
|
||||
if isinstance(p, Symbol):
|
||||
result.append({"name": p.name, "type": None})
|
||||
elif isinstance(p, list) and len(p) == 3:
|
||||
# (name :as type)
|
||||
name_s, kw, type_s = p
|
||||
if isinstance(name_s, Symbol) and isinstance(kw, Keyword) and kw.name == "as":
|
||||
type_str = type_s.name if isinstance(type_s, Symbol) else str(type_s)
|
||||
result.append({"name": name_s.name, "type": type_str})
|
||||
else:
|
||||
result.append({"name": str(p), "type": None})
|
||||
else:
|
||||
result.append({"name": str(p), "type": None})
|
||||
i += 1
|
||||
return result
|
||||
|
||||
# Process defines
|
||||
all_defines: list[dict] = []
|
||||
py_emitter = None
|
||||
|
||||
for expr in exprs:
|
||||
if not isinstance(expr, list) or len(expr) < 2:
|
||||
continue
|
||||
if not isinstance(expr[0], Symbol):
|
||||
continue
|
||||
|
||||
head = expr[0].name
|
||||
if head not in ("define", "define-async"):
|
||||
continue
|
||||
|
||||
name_node = expr[1]
|
||||
name = name_node.name if isinstance(name_node, Symbol) else str(name_node)
|
||||
|
||||
effects = _extract_effects(expr)
|
||||
params = _extract_params(expr)
|
||||
src, line_num = _find_source_block(name, head)
|
||||
|
||||
kind = "function"
|
||||
# Check if it's a constant (no fn/lambda body)
|
||||
val_idx = 4 if (len(expr) >= 5 and isinstance(expr[2], Keyword)
|
||||
and expr[2].name == "effects") else 2
|
||||
if val_idx < len(expr):
|
||||
val = expr[val_idx]
|
||||
if isinstance(val, list) and val and isinstance(val[0], Symbol) and val[0].name in ("fn", "lambda"):
|
||||
kind = "async-function" if head == "define-async" else "function"
|
||||
else:
|
||||
kind = "constant"
|
||||
if head == "define-async":
|
||||
kind = "async-function"
|
||||
|
||||
# --- Python translation ---
|
||||
py_code = None
|
||||
try:
|
||||
if py_emitter is None:
|
||||
from shared.sx.ref.bootstrap_py import PyEmitter
|
||||
py_emitter = PyEmitter()
|
||||
if head == "define-async":
|
||||
py_code = py_emitter._emit_define_async(expr)
|
||||
else:
|
||||
py_code = py_emitter._emit_define(expr)
|
||||
except Exception:
|
||||
pass
|
||||
|
||||
# --- JavaScript translation ---
|
||||
js_code = None
|
||||
try:
|
||||
js_code = _js_translate_define(expr, name)
|
||||
except Exception:
|
||||
pass
|
||||
|
||||
# --- Z3/SMT-LIB translation ---
|
||||
z3_code = None
|
||||
try:
|
||||
z3_code = _z3_translate_define(expr)
|
||||
except Exception:
|
||||
pass
|
||||
|
||||
# --- Cross-references ---
|
||||
refs = []
|
||||
platform_deps = []
|
||||
try:
|
||||
spec_index = _build_spec_index()
|
||||
body_symbols = _collect_symbols(expr)
|
||||
own_names = {name}
|
||||
for sym in body_symbols - own_names:
|
||||
if sym in spec_index:
|
||||
refs.append(sym)
|
||||
# Symbols not in any spec file might be platform primitives
|
||||
except Exception:
|
||||
pass
|
||||
|
||||
define_entry = {
|
||||
"name": name,
|
||||
"kind": kind,
|
||||
"effects": effects,
|
||||
"params": params,
|
||||
"source": src,
|
||||
"line": line_num,
|
||||
"python": py_code,
|
||||
"javascript": js_code,
|
||||
"z3": z3_code,
|
||||
"refs": refs,
|
||||
"tests": [],
|
||||
"test-count": 0,
|
||||
}
|
||||
all_defines.append(define_entry)
|
||||
|
||||
# --- Assign defines to sections ---
|
||||
# Match by line number: each define belongs to the section whose header
|
||||
# precedes it in the source
|
||||
section_line_map: list[tuple[int, dict]] = []
|
||||
for s in sections:
|
||||
# Find the line where section title appears
|
||||
t = s["title"]
|
||||
for li, line in enumerate(lines, 1):
|
||||
if t in line:
|
||||
section_line_map.append((li, s))
|
||||
break
|
||||
section_line_map.sort(key=lambda x: x[0])
|
||||
|
||||
for d in all_defines:
|
||||
dl = d.get("line", 0)
|
||||
target_section = sections[0]
|
||||
for sl, s in section_line_map:
|
||||
if dl >= sl:
|
||||
target_section = s
|
||||
target_section["defines"].append(d)
|
||||
|
||||
# --- Test matching ---
|
||||
all_tests = _extract_tests_for_spec(filename)
|
||||
test_total = 0
|
||||
for d in all_defines:
|
||||
matched = _match_tests_to_function(d["name"], all_tests)
|
||||
if matched:
|
||||
test_names = []
|
||||
for suite in matched:
|
||||
for t in suite["tests"]:
|
||||
test_names.append({"name": t, "suite": suite["suite"]})
|
||||
d["tests"] = test_names
|
||||
d["test-count"] = len(test_names)
|
||||
test_total += len(test_names)
|
||||
|
||||
# --- Stats ---
|
||||
pure_count = sum(1 for d in all_defines if not d["effects"])
|
||||
mutation_count = sum(1 for d in all_defines if "mutation" in d["effects"])
|
||||
io_count = sum(1 for d in all_defines if "io" in d["effects"])
|
||||
render_count = sum(1 for d in all_defines if "render" in d["effects"])
|
||||
|
||||
# --- Platform interface ---
|
||||
platform_items = []
|
||||
for line in lines:
|
||||
m = re.match(r"^;;\s+\((\S+)\s+(.*?)\)\s+→\s+(\S+)\s+—\s+(.+)", line)
|
||||
if m:
|
||||
platform_items.append({
|
||||
"name": m.group(1),
|
||||
"params": m.group(2),
|
||||
"returns": m.group(3),
|
||||
"doc": m.group(4).strip(),
|
||||
})
|
||||
|
||||
# Filter out empty sections
|
||||
sections = [s for s in sections if s["defines"]]
|
||||
|
||||
return {
|
||||
"filename": filename,
|
||||
"title": title,
|
||||
"desc": desc,
|
||||
"sections": sections,
|
||||
"platform-interface": platform_items,
|
||||
"stats": {
|
||||
"total-defines": len(all_defines),
|
||||
"pure-count": pure_count,
|
||||
"mutation-count": mutation_count,
|
||||
"io-count": io_count,
|
||||
"render-count": render_count,
|
||||
"lines": len(lines),
|
||||
"test-total": test_total,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
def _bootstrapper_data(target: str) -> dict:
|
||||
"""Return bootstrapper source and generated output for a target.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user