sx-host plan steps 1-2: defhelper + SX config + SXTP spec + nav tools
Step 1 — defhelper: SX-defined page data helpers replace Python helpers. (defhelper name (params) body) in .sx files, using existing IO primitives (query, action, service). Loaded into OCaml kernel as pure SX defines. Step 2 — SX config: app-config.sx replaces app-config.yaml with (defconfig) form. (env-get "VAR") resolves secrets from environment. Kebab-to-underscore aliasing ensures backward compatibility with all 174 config consumers. Also: SXTP protocol spec (applications/sxtp/spec.sx), docs article, sx_nav move/delete modes, reactive-runtime moved to geography. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
1
_config/app-config.sx
Normal file
1
_config/app-config.sx
Normal file
@@ -0,0 +1 @@
|
||||
(defconfig app {:market-root "/market" :host "https://rose-ash.com" :base-url "https://wholesale.suma.coop/" :base-login "https://wholesale.suma.coop/customer/account/login/" :slugs {:skip ("" "customer" "account" "checkout" "wishlist" "sales" "contact" "privacy-policy" "terms-and-conditions" "delivery" "catalogsearch" "quickorder" "apply" "search" "static" "media")} :categories {:allow {:Chilled "chilled" :Non-foods "non-foods" :Branded-Goods "branded-goods" :Frozen "frozen" :Basics "basics" :Supplements "supplements" :Christmas "christmas"}} :section-titles ("ingredients" "allergy information" "allergens" "nutritional information" "nutrition" "storage" "directions" "preparation" "serving suggestions" "origin" "country of origin" "recycling" "general information" "additional information" "a note about prices") :blacklist {:category ("branded-goods/alcoholic-drinks" "branded-goods/beers" "branded-goods/ciders" "branded-goods/wines") :product ("list-price-suma-current-suma-price-list-each-bk012-2-html") :product-details ("General Information" "A Note About Prices")} :cart-root "/cart" :cache {:fs-root "/app/_snapshot"} :market-title "Market" :app-urls {:sx "https://sx.rose-ash.com" :account "https://account.rose-ash.com" :events "https://events.rose-ash.com" :federation "https://federation.rose-ash.com" :cart "https://cart.rose-ash.com" :orders "https://orders.rose-ash.com" :test "https://test.rose-ash.com" :blog "https://blog.rose-ash.com" :market "https://market.rose-ash.com"} :title "ROSE-ASH 2.0" :blog-root "/" :sumup {:merchant-code "ME4J6100" :currency "GBP" :webhook-secret (env-get "SUMUP_WEBHOOK_SECRET") :api-key (env-get "SUMUP_API_KEY")} :root "/rose-ash-wholefood-coop" :base-host "wholesale.suma.coop" :blog-title "all the news"})
|
||||
1
blog/config/app-config.sx
Normal file
1
blog/config/app-config.sx
Normal file
@@ -0,0 +1 @@
|
||||
(defconfig app {:market-root "/market" :host "https://rose-ash.com" :base-url "https://wholesale.suma.coop/" :base-login "https://wholesale.suma.coop/customer/account/login/" :slugs {:skip ("" "customer" "account" "checkout" "wishlist" "sales" "contact" "privacy-policy" "terms-and-conditions" "delivery" "catalogsearch" "quickorder" "apply" "search" "static" "media")} :categories {:allow {:Chilled "chilled" :Non-foods "non-foods" :Branded-Goods "branded-goods" :Frozen "frozen" :Basics "basics" :Supplements "supplements" :Christmas "christmas"}} :section-titles ("ingredients" "allergy information" "allergens" "nutritional information" "nutrition" "storage" "directions" "preparation" "serving suggestions" "origin" "country of origin" "recycling" "general information" "additional information" "a note about prices") :blacklist {:category ("branded-goods/alcoholic-drinks" "branded-goods/beers" "branded-goods/ciders" "branded-goods/wines") :product ("list-price-suma-current-suma-price-list-each-bk012-2-html") :product-details ("General Information" "A Note About Prices")} :cart-root "/cart" :cache {:fs-root "/app/_snapshot"} :market-title "Market" :app-urls {:sx "https://sx.rose-ash.com" :account "https://account.rose-ash.com" :events "https://events.rose-ash.com" :federation "https://federation.rose-ash.com" :cart "https://cart.rose-ash.com" :orders "https://orders.rose-ash.com" :test "https://test.rose-ash.com" :blog "https://blog.rose-ash.com" :market "https://market.rose-ash.com"} :title "ROSE-ASH 2.0" :blog-root "/" :sumup {:merchant-code "ME4J6100" :currency "GBP" :webhook-secret (env-get "SUMUP_WEBHOOK_SECRET") :api-key (env-get "SUMUP_API_KEY")} :root "/rose-ash-wholefood-coop" :base-host "wholesale.suma.coop" :blog-title "all the news"})
|
||||
1
cart/config/app-config.sx
Normal file
1
cart/config/app-config.sx
Normal file
@@ -0,0 +1 @@
|
||||
(defconfig app {:market-root "/market" :host "https://rose-ash.com" :base-url "https://wholesale.suma.coop/" :base-login "https://wholesale.suma.coop/customer/account/login/" :slugs {:skip ("" "customer" "account" "checkout" "wishlist" "sales" "contact" "privacy-policy" "terms-and-conditions" "delivery" "catalogsearch" "quickorder" "apply" "search" "static" "media")} :categories {:allow {:Chilled "chilled" :Non-foods "non-foods" :Branded-Goods "branded-goods" :Frozen "frozen" :Basics "basics" :Supplements "supplements" :Christmas "christmas"}} :section-titles ("ingredients" "allergy information" "allergens" "nutritional information" "nutrition" "storage" "directions" "preparation" "serving suggestions" "origin" "country of origin" "recycling" "general information" "additional information" "a note about prices") :blacklist {:category ("branded-goods/alcoholic-drinks" "branded-goods/beers" "branded-goods/ciders" "branded-goods/wines") :product ("list-price-suma-current-suma-price-list-each-bk012-2-html") :product-details ("General Information" "A Note About Prices")} :cart-root "/cart" :cache {:fs-root "/app/_snapshot"} :market-title "Market" :app-urls {:sx "https://sx.rose-ash.com" :account "https://account.rose-ash.com" :events "https://events.rose-ash.com" :federation "https://federation.rose-ash.com" :cart "https://cart.rose-ash.com" :orders "https://orders.rose-ash.com" :test "https://test.rose-ash.com" :blog "https://blog.rose-ash.com" :market "https://market.rose-ash.com"} :title "ROSE-ASH 2.0" :blog-root "/" :sumup {:merchant-code "ME4J6100" :currency "GBP" :webhook-secret (env-get "SUMUP_WEBHOOK_SECRET") :api-key (env-get "SUMUP_API_KEY")} :root "/rose-ash-wholefood-coop" :base-host "wholesale.suma.coop" :blog-title "all the news"})
|
||||
1
events/config/app-config.sx
Normal file
1
events/config/app-config.sx
Normal file
@@ -0,0 +1 @@
|
||||
(defconfig app {:market-root "/market" :host "https://rose-ash.com" :base-url "https://wholesale.suma.coop/" :base-login "https://wholesale.suma.coop/customer/account/login/" :slugs {:skip ("" "customer" "account" "checkout" "wishlist" "sales" "contact" "privacy-policy" "terms-and-conditions" "delivery" "catalogsearch" "quickorder" "apply" "search" "static" "media")} :categories {:allow {:Chilled "chilled" :Non-foods "non-foods" :Branded-Goods "branded-goods" :Frozen "frozen" :Basics "basics" :Supplements "supplements" :Christmas "christmas"}} :section-titles ("ingredients" "allergy information" "allergens" "nutritional information" "nutrition" "storage" "directions" "preparation" "serving suggestions" "origin" "country of origin" "recycling" "general information" "additional information" "a note about prices") :blacklist {:category ("branded-goods/alcoholic-drinks" "branded-goods/beers" "branded-goods/ciders" "branded-goods/wines") :product ("list-price-suma-current-suma-price-list-each-bk012-2-html") :product-details ("General Information" "A Note About Prices")} :cart-root "/cart" :cache {:fs-root "/app/_snapshot"} :market-title "Market" :app-urls {:sx "https://sx.rose-ash.com" :account "https://account.rose-ash.com" :events "https://events.rose-ash.com" :federation "https://federation.rose-ash.com" :cart "https://cart.rose-ash.com" :orders "https://orders.rose-ash.com" :test "https://test.rose-ash.com" :blog "https://blog.rose-ash.com" :market "https://market.rose-ash.com"} :title "ROSE-ASH 2.0" :blog-root "/" :sumup {:merchant-code "ME4J6100" :currency "GBP" :webhook-secret (env-get "SUMUP_WEBHOOK_SECRET") :api-key (env-get "SUMUP_API_KEY")} :root "/rose-ash-wholefood-coop" :base-host "wholesale.suma.coop" :blog-title "all the news"})
|
||||
1
federation/config/app-config.sx
Normal file
1
federation/config/app-config.sx
Normal file
@@ -0,0 +1 @@
|
||||
(defconfig app {:market-root "/market" :host "https://rose-ash.com" :base-url "https://wholesale.suma.coop/" :base-login "https://wholesale.suma.coop/customer/account/login/" :slugs {:skip ("" "customer" "account" "checkout" "wishlist" "sales" "contact" "privacy-policy" "terms-and-conditions" "delivery" "catalogsearch" "quickorder" "apply" "search" "static" "media")} :categories {:allow {:Chilled "chilled" :Non-foods "non-foods" :Branded-Goods "branded-goods" :Frozen "frozen" :Basics "basics" :Supplements "supplements" :Christmas "christmas"}} :section-titles ("ingredients" "allergy information" "allergens" "nutritional information" "nutrition" "storage" "directions" "preparation" "serving suggestions" "origin" "country of origin" "recycling" "general information" "additional information" "a note about prices") :blacklist {:category ("branded-goods/alcoholic-drinks" "branded-goods/beers" "branded-goods/ciders" "branded-goods/wines") :product ("list-price-suma-current-suma-price-list-each-bk012-2-html") :product-details ("General Information" "A Note About Prices")} :cart-root "/cart" :cache {:fs-root "/app/_snapshot"} :market-title "Market" :app-urls {:sx "https://sx.rose-ash.com" :account "https://account.rose-ash.com" :events "https://events.rose-ash.com" :federation "https://federation.rose-ash.com" :cart "https://cart.rose-ash.com" :orders "https://orders.rose-ash.com" :test "https://test.rose-ash.com" :blog "https://blog.rose-ash.com" :market "https://market.rose-ash.com"} :title "ROSE-ASH 2.0" :blog-root "/" :sumup {:merchant-code "ME4J6100" :currency "GBP" :webhook-secret (env-get "SUMUP_WEBHOOK_SECRET") :api-key (env-get "SUMUP_API_KEY")} :root "/rose-ash-wholefood-coop" :base-host "wholesale.suma.coop" :blog-title "all the news"})
|
||||
@@ -891,7 +891,192 @@ let rec handle_tool name args =
|
||||
text_result (Printf.sprintf "Created:\n File: %s\n Component: %s\n Page fn: %s\n Nav href: %s" file comp slug href)
|
||||
end
|
||||
end
|
||||
| m -> error_result (Printf.sprintf "unknown mode: %s (list, check, add)" m))
|
||||
| "delete" ->
|
||||
let slug = (try args |> member "slug" |> to_string with _ -> "") in
|
||||
if slug = "" then error_result "slug required"
|
||||
else begin
|
||||
let changes = Buffer.create 256 in
|
||||
let log s = Buffer.add_string changes s; Buffer.add_char changes '\n' in
|
||||
(* Helper: remove a top-level (define name ...) block from text *)
|
||||
let remove_define_block text name =
|
||||
let pattern = Printf.sprintf "(define %s " name in
|
||||
match try Some (Str.search_forward (Str.regexp_string pattern) text 0) with Not_found -> None with
|
||||
| None -> text
|
||||
| Some start ->
|
||||
(* Find matching close paren *)
|
||||
let depth = ref 0 in
|
||||
let finish = ref (String.length text) in
|
||||
for i = start to String.length text - 1 do
|
||||
if text.[i] = '(' then incr depth
|
||||
else if text.[i] = ')' then begin
|
||||
decr depth;
|
||||
if !depth = 0 && !finish = String.length text then
|
||||
finish := i + 1
|
||||
end
|
||||
done;
|
||||
(* Also consume trailing newlines *)
|
||||
let e = ref !finish in
|
||||
while !e < String.length text && text.[!e] = '\n' do incr e done;
|
||||
String.sub text 0 start ^ String.sub text !e (String.length text - !e)
|
||||
in
|
||||
(* 1. Remove from nav-data.sx *)
|
||||
let nf = sx_dir ^ "/nav-data.sx" in
|
||||
let ns = In_channel.with_open_text nf In_channel.input_all in
|
||||
let nav_items_name = slug ^ "-nav-items" in
|
||||
let ns2 = remove_define_block ns nav_items_name in
|
||||
if ns2 <> ns then begin
|
||||
Out_channel.with_open_text nf (fun oc -> output_string oc ns2);
|
||||
log (Printf.sprintf "nav-data.sx: removed define %s" nav_items_name)
|
||||
end;
|
||||
(* 2. Remove from nav-tree.sx — find the dict block with matching href *)
|
||||
let tf = sx_dir ^ "/nav-tree.sx" in
|
||||
let ts = In_channel.with_open_text tf In_channel.input_all in
|
||||
let href_pat = Printf.sprintf "\"(/sx/(%%.(%s" slug in
|
||||
(* Match any section: find the (dict ... :href "/sx/(SECTION.(SLUG..." block *)
|
||||
let slug_re = Str.regexp (Printf.sprintf ":href \"/sx/([a-z]+\\.(%s" (Str.quote slug)) in
|
||||
let ts2 = match try Some (Str.search_forward slug_re ts 0) with Not_found -> None with
|
||||
| None -> ignore href_pat; ts
|
||||
| Some _ ->
|
||||
(* Walk back to find the opening (dict *)
|
||||
let href_pos = Str.match_beginning () in
|
||||
let start = ref href_pos in
|
||||
while !start > 0 && String.sub ts !start 4 <> "dict" do decr start done;
|
||||
(* Back one more for the opening paren *)
|
||||
while !start > 0 && ts.[!start] <> '(' do decr start done;
|
||||
(* Find matching close paren *)
|
||||
let depth = ref 0 in
|
||||
let finish = ref (String.length ts) in
|
||||
for i = !start to String.length ts - 1 do
|
||||
if ts.[i] = '(' then incr depth
|
||||
else if ts.[i] = ')' then begin
|
||||
decr depth;
|
||||
if !depth = 0 && !finish = String.length ts then
|
||||
finish := i + 1
|
||||
end
|
||||
done;
|
||||
(* Consume trailing whitespace/newlines *)
|
||||
let e = ref !finish in
|
||||
while !e < String.length ts && (ts.[!e] = '\n' || ts.[!e] = ' ') do incr e done;
|
||||
log (Printf.sprintf "nav-tree.sx: removed entry for %s" slug);
|
||||
String.sub ts 0 !start ^ String.sub ts !e (String.length ts - !e)
|
||||
in
|
||||
if ts2 <> ts then
|
||||
Out_channel.with_open_text tf (fun oc -> output_string oc ts2);
|
||||
(* 3. Remove from page-functions.sx *)
|
||||
let pf = sx_dir ^ "/page-functions.sx" in
|
||||
let ps = In_channel.with_open_text pf In_channel.input_all in
|
||||
let ps2 = remove_define_block ps slug in
|
||||
if ps2 <> ps then begin
|
||||
Out_channel.with_open_text pf (fun oc -> output_string oc ps2);
|
||||
log (Printf.sprintf "page-functions.sx: removed define %s" slug)
|
||||
end;
|
||||
text_result (Printf.sprintf "Deleted %s:\n%s" slug (Buffer.contents changes))
|
||||
end
|
||||
| "move" ->
|
||||
let slug = (try args |> member "slug" |> to_string with _ -> "") in
|
||||
let from_sec = (try args |> member "from" |> to_string with _ -> "") in
|
||||
let to_sec = (try args |> member "to" |> to_string with _ ->
|
||||
match section_filter with Some s -> s | None -> "") in
|
||||
if slug = "" || from_sec = "" || to_sec = "" then
|
||||
error_result "slug, from, and to (or section) required"
|
||||
else if from_sec = to_sec then
|
||||
error_result "from and to must differ"
|
||||
else begin
|
||||
let changes = Buffer.create 256 in
|
||||
let log s = Buffer.add_string changes s; Buffer.add_char changes '\n' in
|
||||
let old_prefix = from_sec ^ ".(" ^ slug in
|
||||
let new_prefix = to_sec ^ ".(" ^ slug in
|
||||
(* 1. Rewrite hrefs in nav-data.sx *)
|
||||
let nf = sx_dir ^ "/nav-data.sx" in
|
||||
let ns = In_channel.with_open_text nf In_channel.input_all in
|
||||
let ns2 = Str.global_replace (Str.regexp_string old_prefix) new_prefix ns in
|
||||
if ns2 <> ns then begin
|
||||
Out_channel.with_open_text nf (fun oc -> output_string oc ns2);
|
||||
log (Printf.sprintf "nav-data.sx: rewrote hrefs %s → %s" from_sec to_sec)
|
||||
end;
|
||||
(* 2. Move entry in nav-tree.sx: extract block from source, rewrite hrefs, insert into target *)
|
||||
let tf = sx_dir ^ "/nav-tree.sx" in
|
||||
let ts = In_channel.with_open_text tf In_channel.input_all in
|
||||
(* First rewrite all hrefs *)
|
||||
let ts2 = Str.global_replace (Str.regexp_string old_prefix) new_prefix ts in
|
||||
(* Find the dict block for this slug *)
|
||||
let slug_re = Str.regexp (Printf.sprintf ":href \"/sx/([a-z]+\\.(%s" (Str.quote slug)) in
|
||||
let ts3 = match try Some (Str.search_forward slug_re ts2 0) with Not_found -> None with
|
||||
| None ->
|
||||
log "nav-tree.sx: hrefs rewritten (no entry block found to relocate)";
|
||||
ts2
|
||||
| Some _ ->
|
||||
let href_pos = Str.match_beginning () in
|
||||
(* Walk back to (dict *)
|
||||
let start = ref href_pos in
|
||||
while !start > 0 && String.sub ts2 !start 4 <> "dict" do decr start done;
|
||||
while !start > 0 && ts2.[!start] <> '(' do decr start done;
|
||||
(* Find matching close paren *)
|
||||
let depth = ref 0 in
|
||||
let finish = ref (String.length ts2) in
|
||||
for i = !start to String.length ts2 - 1 do
|
||||
if ts2.[i] = '(' then incr depth
|
||||
else if ts2.[i] = ')' then begin
|
||||
decr depth;
|
||||
if !depth = 0 && !finish = String.length ts2 then
|
||||
finish := i + 1
|
||||
end
|
||||
done;
|
||||
let block = String.sub ts2 !start (!finish - !start) in
|
||||
(* Remove block from source position *)
|
||||
let e = ref !finish in
|
||||
while !e < String.length ts2 && (ts2.[!e] = '\n' || ts2.[!e] = ' ') do incr e done;
|
||||
let without = String.sub ts2 0 !start ^ String.sub ts2 !e (String.length ts2 - !e) in
|
||||
(* Insert into target section — find the last child before the closing paren of target's :children *)
|
||||
let target_href = Printf.sprintf "\"/sx/(%s)\"" to_sec in
|
||||
(match try Some (Str.search_forward (Str.regexp_string target_href) without 0) with Not_found -> None with
|
||||
| None ->
|
||||
log (Printf.sprintf "nav-tree.sx: hrefs rewritten but target section %s not found" to_sec);
|
||||
without
|
||||
| Some _ ->
|
||||
let target_pos = Str.match_beginning () in
|
||||
(* Find :children after target_pos *)
|
||||
let children_re = Str.regexp_string ":children" in
|
||||
(match try Some (Str.search_forward children_re without target_pos) with Not_found -> None with
|
||||
| None ->
|
||||
log (Printf.sprintf "nav-tree.sx: target %s has no :children" to_sec);
|
||||
without
|
||||
| Some _ ->
|
||||
let ch_pos = Str.match_beginning () in
|
||||
(* Find the opening paren of the children list *)
|
||||
let lp = ref (ch_pos + 9) in
|
||||
while !lp < String.length without && without.[!lp] <> '(' do incr lp done;
|
||||
(* Find its matching close paren *)
|
||||
let d = ref 0 in
|
||||
let close = ref (String.length without) in
|
||||
for i = !lp to String.length without - 1 do
|
||||
if without.[i] = '(' then incr d
|
||||
else if without.[i] = ')' then begin
|
||||
decr d;
|
||||
if !d = 0 && !close = String.length without then
|
||||
close := i
|
||||
end
|
||||
done;
|
||||
(* Insert block just before the closing paren *)
|
||||
let indent = "\n " in
|
||||
let result = String.sub without 0 !close ^ indent ^ block ^ String.sub without !close (String.length without - !close) in
|
||||
log (Printf.sprintf "nav-tree.sx: moved %s from %s to %s" slug from_sec to_sec);
|
||||
result))
|
||||
in
|
||||
Out_channel.with_open_text tf (fun oc -> output_string oc ts3);
|
||||
(* 3. Rewrite page-functions.sx component prefix if needed *)
|
||||
let pf = sx_dir ^ "/page-functions.sx" in
|
||||
let ps = In_channel.with_open_text pf In_channel.input_all in
|
||||
let old_comp_prefix = "~" ^ from_sec ^ "/" ^ slug ^ "/" in
|
||||
let new_comp_prefix = "~" ^ to_sec ^ "/" ^ slug ^ "/" in
|
||||
let ps2 = Str.global_replace (Str.regexp_string old_comp_prefix) new_comp_prefix ps in
|
||||
if ps2 <> ps then begin
|
||||
Out_channel.with_open_text pf (fun oc -> output_string oc ps2);
|
||||
log (Printf.sprintf "page-functions.sx: rewrote %s → %s" old_comp_prefix new_comp_prefix)
|
||||
end;
|
||||
text_result (Printf.sprintf "Moved %s: %s → %s\n%s" slug from_sec to_sec (Buffer.contents changes))
|
||||
end
|
||||
| m -> error_result (Printf.sprintf "unknown mode: %s (list, check, add, move, delete)" m))
|
||||
|
||||
| "sx_playwright" ->
|
||||
let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
|
||||
@@ -1612,11 +1797,13 @@ let tool_definitions = `List [
|
||||
("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order")]);
|
||||
("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")])]
|
||||
["expr"];
|
||||
tool "sx_nav" "Manage sx-docs navigation and articles. Modes: list (all nav items with status), check (validate consistency — orphan links, missing components, broken routes), add (create new article with nav entry + page function + component scaffold)."
|
||||
[("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: list, check, or add")]);
|
||||
("section", `Assoc [("type", `String "string"); ("description", `String "Nav section to filter (e.g. applications, etc, geography)")]);
|
||||
tool "sx_nav" "Manage sx-docs navigation and articles. Modes: list (all nav items with status), check (validate consistency), add (create article + nav entry), delete (remove nav entry + page fn), move (move entry between sections, rewriting hrefs)."
|
||||
[("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: list, check, add, delete, or move")]);
|
||||
("section", `Assoc [("type", `String "string"); ("description", `String "Nav section to filter (list), target section (add), or target section (move)")]);
|
||||
("title", `Assoc [("type", `String "string"); ("description", `String "Article title (add mode)")]);
|
||||
("slug", `Assoc [("type", `String "string"); ("description", `String "URL slug (add mode, e.g. native-browser)")])]
|
||||
("slug", `Assoc [("type", `String "string"); ("description", `String "URL slug (add/delete/move modes, e.g. reactive-runtime)")]);
|
||||
("from", `Assoc [("type", `String "string"); ("description", `String "Source section (move mode, e.g. applications)")]);
|
||||
("to", `Assoc [("type", `String "string"); ("description", `String "Target section (move mode, e.g. geography)")])]
|
||||
[];
|
||||
tool "sx_playwright" "Run Playwright browser tests or inspect SX pages interactively. Modes: run (spec files), inspect (page/island report with leak detection and handler audit), diff (full SSR vs hydrated DOM), hydrate (lake-focused SSR vs hydrated comparison — detects clobbering), eval (JS expression), interact (action sequence), screenshot, listeners (CDP event listener inspection), trace (click + capture console/network/pushState), cdp (raw CDP command)."
|
||||
[("spec", `Assoc [("type", `String "string"); ("description", `String "Spec file to run (run mode). e.g. stepper.spec.js")]);
|
||||
|
||||
1
market/config/app-config.sx
Normal file
1
market/config/app-config.sx
Normal file
@@ -0,0 +1 @@
|
||||
(defconfig app {:market-root "/market" :host "https://rose-ash.com" :base-url "https://wholesale.suma.coop/" :base-login "https://wholesale.suma.coop/customer/account/login/" :slugs {:skip ("" "customer" "account" "checkout" "wishlist" "sales" "contact" "privacy-policy" "terms-and-conditions" "delivery" "catalogsearch" "quickorder" "apply" "search" "static" "media")} :categories {:allow {:Chilled "chilled" :Non-foods "non-foods" :Branded-Goods "branded-goods" :Frozen "frozen" :Basics "basics" :Supplements "supplements" :Christmas "christmas"}} :section-titles ("ingredients" "allergy information" "allergens" "nutritional information" "nutrition" "storage" "directions" "preparation" "serving suggestions" "origin" "country of origin" "recycling" "general information" "additional information" "a note about prices") :blacklist {:category ("branded-goods/alcoholic-drinks" "branded-goods/beers" "branded-goods/ciders" "branded-goods/wines") :product ("list-price-suma-current-suma-price-list-each-bk012-2-html") :product-details ("General Information" "A Note About Prices")} :cart-root "/cart" :cache {:fs-root "/app/_snapshot"} :market-title "Market" :app-urls {:sx "https://sx.rose-ash.com" :account "https://account.rose-ash.com" :events "https://events.rose-ash.com" :federation "https://federation.rose-ash.com" :cart "https://cart.rose-ash.com" :orders "https://orders.rose-ash.com" :test "https://test.rose-ash.com" :blog "https://blog.rose-ash.com" :market "https://market.rose-ash.com"} :title "ROSE-ASH 2.0" :blog-root "/" :sumup {:merchant-code "ME4J6100" :currency "GBP" :webhook-secret (env-get "SUMUP_WEBHOOK_SECRET") :api-key (env-get "SUMUP_API_KEY")} :root "/rose-ash-wholefood-coop" :base-host "wholesale.suma.coop" :blog-title "all the news"})
|
||||
119
shared/config.py
119
shared/config.py
@@ -1,4 +1,4 @@
|
||||
# suma_browser/config.py
|
||||
# shared/config.py — SX-first config loader with YAML fallback
|
||||
from __future__ import annotations
|
||||
|
||||
import asyncio
|
||||
@@ -6,13 +6,16 @@ import os
|
||||
from types import MappingProxyType
|
||||
from typing import Any, Optional
|
||||
import copy
|
||||
import yaml
|
||||
|
||||
# Default config path (override with APP_CONFIG_FILE)
|
||||
_DEFAULT_CONFIG_PATH = os.environ.get(
|
||||
# Default config paths (override with APP_CONFIG_FILE)
|
||||
_DEFAULT_YAML_PATH = os.environ.get(
|
||||
"APP_CONFIG_FILE",
|
||||
os.path.join(os.getcwd(), "config/app-config.yaml"),
|
||||
)
|
||||
_DEFAULT_SX_PATH = os.environ.get(
|
||||
"APP_CONFIG_SX_FILE",
|
||||
os.path.join(os.getcwd(), "config/app-config.sx"),
|
||||
)
|
||||
|
||||
# Module state
|
||||
_init_lock = asyncio.Lock()
|
||||
@@ -23,7 +26,6 @@ _data_plain: Any = None # plain builtins for pretty-print / logging
|
||||
def _freeze(obj: Any) -> Any:
|
||||
"""Deep-freeze containers to read-only equivalents."""
|
||||
if isinstance(obj, dict):
|
||||
# freeze children first, then wrap dict in mappingproxy
|
||||
return MappingProxyType({k: _freeze(v) for k, v in obj.items()})
|
||||
if isinstance(obj, list):
|
||||
return tuple(_freeze(v) for v in obj)
|
||||
@@ -33,10 +35,88 @@ def _freeze(obj: Any) -> Any:
|
||||
return tuple(_freeze(v) for v in obj)
|
||||
return obj
|
||||
|
||||
|
||||
def _sx_to_dict(expr: Any) -> Any:
|
||||
"""Convert parsed SX config values to plain Python dicts/lists.
|
||||
|
||||
- Keyword keys become strings (kebab-case preserved, also aliased to
|
||||
underscore form for backward compatibility with YAML consumers).
|
||||
- (env-get "VAR") calls are resolved to os.environ.
|
||||
- Lists become plain Python lists.
|
||||
- Everything else passes through as-is.
|
||||
"""
|
||||
from shared.sx.types import Keyword, Symbol
|
||||
|
||||
# (env-get "VAR") → os.environ.get("VAR")
|
||||
if isinstance(expr, list) and len(expr) == 2:
|
||||
head = expr[0]
|
||||
if isinstance(head, Symbol) and head.name == "env-get":
|
||||
var_name = str(expr[1])
|
||||
return os.environ.get(var_name)
|
||||
|
||||
# dict with keyword keys
|
||||
if isinstance(expr, dict):
|
||||
result: dict[str, Any] = {}
|
||||
for k, v in expr.items():
|
||||
key = k if isinstance(k, str) else str(k)
|
||||
val = _sx_to_dict(v)
|
||||
result[key] = val
|
||||
# Alias kebab-case → underscore for backward compat
|
||||
underscore = key.replace("-", "_")
|
||||
if underscore != key:
|
||||
result[underscore] = val
|
||||
return result
|
||||
|
||||
if isinstance(expr, list):
|
||||
# Check for (env-get ...) first (already handled above for len==2)
|
||||
return [_sx_to_dict(item) for item in expr]
|
||||
|
||||
if isinstance(expr, tuple):
|
||||
return [_sx_to_dict(item) for item in expr]
|
||||
|
||||
if isinstance(expr, Keyword):
|
||||
return str(expr)
|
||||
|
||||
if isinstance(expr, Symbol):
|
||||
name = expr.name
|
||||
if name == "true":
|
||||
return True
|
||||
if name == "false":
|
||||
return False
|
||||
if name == "nil":
|
||||
return None
|
||||
return name
|
||||
|
||||
return expr
|
||||
|
||||
|
||||
def _load_sx_config(path: str) -> dict:
|
||||
"""Load an SX config file and return a plain dict.
|
||||
|
||||
Expects a single (defconfig name body) form.
|
||||
"""
|
||||
from shared.sx.parser import parse_all
|
||||
|
||||
with open(path, "r", encoding="utf-8") as f:
|
||||
source = f.read()
|
||||
|
||||
exprs = parse_all(source)
|
||||
for expr in exprs:
|
||||
if (isinstance(expr, list) and len(expr) >= 3
|
||||
and hasattr(expr[0], 'name') and expr[0].name == "defconfig"):
|
||||
# (defconfig name {body})
|
||||
body = expr[2]
|
||||
return _sx_to_dict(body)
|
||||
|
||||
raise ValueError(f"No (defconfig ...) form found in {path}")
|
||||
|
||||
|
||||
# ---------------- API ----------------
|
||||
async def init_config(path: Optional[str] = None, *, force: bool = False) -> None:
|
||||
"""
|
||||
Load YAML exactly as-is and cache both a frozen (read-only) and a plain copy.
|
||||
Load config and cache both a frozen (read-only) and a plain copy.
|
||||
|
||||
Prefers SX config (app-config.sx) when available, falls back to YAML.
|
||||
Idempotent; pass force=True to reload.
|
||||
"""
|
||||
global _data_frozen, _data_plain
|
||||
@@ -48,14 +128,20 @@ async def init_config(path: Optional[str] = None, *, force: bool = False) -> Non
|
||||
if _data_frozen is not None and not force:
|
||||
return
|
||||
|
||||
cfg_path = path or _DEFAULT_CONFIG_PATH
|
||||
if not os.path.exists(cfg_path):
|
||||
raise FileNotFoundError(f"Config file not found: {cfg_path}")
|
||||
# Try SX first, then YAML
|
||||
sx_path = path if (path and path.endswith(".sx")) else _DEFAULT_SX_PATH
|
||||
yaml_path = path if (path and not path.endswith(".sx")) else _DEFAULT_YAML_PATH
|
||||
|
||||
with open(cfg_path, "r", encoding="utf-8") as f:
|
||||
raw = yaml.safe_load(f) # whatever the YAML root is
|
||||
if os.path.exists(sx_path):
|
||||
raw = _load_sx_config(sx_path)
|
||||
elif os.path.exists(yaml_path):
|
||||
import yaml
|
||||
with open(yaml_path, "r", encoding="utf-8") as f:
|
||||
raw = yaml.safe_load(f)
|
||||
else:
|
||||
raise FileNotFoundError(
|
||||
f"No config found: tried {sx_path} and {yaml_path}")
|
||||
|
||||
# store plain as loaded; store frozen for normal use
|
||||
_data_plain = raw
|
||||
_data_frozen = _freeze(raw)
|
||||
|
||||
@@ -77,8 +163,13 @@ def as_plain() -> Any:
|
||||
|
||||
def pretty() -> str:
|
||||
"""
|
||||
YAML pretty string without mappingproxy noise.
|
||||
Pretty string for logging. Uses YAML if available, else pprint.
|
||||
"""
|
||||
if _data_plain is None:
|
||||
raise RuntimeError("init_config() has not been awaited yet.")
|
||||
return yaml.safe_dump(_data_plain, sort_keys=False, allow_unicode=True)
|
||||
try:
|
||||
import yaml
|
||||
return yaml.safe_dump(_data_plain, sort_keys=False, allow_unicode=True)
|
||||
except ImportError:
|
||||
import pprint
|
||||
return pprint.pformat(_data_plain)
|
||||
|
||||
@@ -308,14 +308,30 @@ class OcamlBridge:
|
||||
return
|
||||
self._helpers_injected = True
|
||||
try:
|
||||
from .pages import get_page_helpers
|
||||
from .pages import get_page_helpers, get_sx_helpers
|
||||
import inspect
|
||||
helpers = get_page_helpers("sx")
|
||||
if not helpers:
|
||||
self._helpers_injected = False
|
||||
return
|
||||
count = 0
|
||||
|
||||
# 1. Inject SX-defined helpers (defhelper) — pure SX, no Python bridge
|
||||
# Load from all services since they're pure SX defines.
|
||||
sx_helpers: dict[str, str] = {}
|
||||
from .pages import _SX_HELPERS
|
||||
for svc_helpers in _SX_HELPERS.values():
|
||||
sx_helpers.update(svc_helpers)
|
||||
for name, sx_source in sx_helpers.items():
|
||||
try:
|
||||
await self._send_command(f'(load-source "{_escape(sx_source)}")')
|
||||
await self._read_until_ok(ctx=None)
|
||||
count += 1
|
||||
except OcamlBridgeError:
|
||||
_logger.warning("Failed to inject SX helper: %s", name)
|
||||
|
||||
# 2. Inject Python helpers — wrapped as (helper "name" ...) IO bridge calls
|
||||
helpers = get_page_helpers("sx")
|
||||
for name, fn in helpers.items():
|
||||
# Skip if already defined by defhelper (SX takes priority)
|
||||
if name in sx_helpers:
|
||||
continue
|
||||
if callable(fn) and not name.startswith("~"):
|
||||
try:
|
||||
sig = inspect.signature(fn)
|
||||
@@ -333,7 +349,12 @@ class OcamlBridge:
|
||||
count += 1
|
||||
except OcamlBridgeError:
|
||||
pass
|
||||
_logger.info("Injected %d page helpers into OCaml kernel", count)
|
||||
|
||||
if not count and not helpers and not sx_helpers:
|
||||
self._helpers_injected = False
|
||||
return
|
||||
_logger.info("Injected %d page helpers into OCaml kernel (%d SX, %d Python)",
|
||||
count, len(sx_helpers), count - len(sx_helpers))
|
||||
except Exception as e:
|
||||
_logger.warning("Helper injection failed: %s", e)
|
||||
self._helpers_injected = False
|
||||
|
||||
@@ -51,6 +51,7 @@ def _eval_error_sx(e: EvalError, context: str) -> str:
|
||||
|
||||
_PAGE_REGISTRY: dict[str, dict[str, PageDef]] = {}
|
||||
_PAGE_HELPERS: dict[str, dict[str, Any]] = {} # service → name → callable
|
||||
_SX_HELPERS: dict[str, dict[str, str]] = {} # service → name → SX source
|
||||
|
||||
|
||||
def register_page(service: str, page_def: PageDef) -> None:
|
||||
@@ -137,6 +138,19 @@ def get_page_helpers(service: str) -> dict[str, Any]:
|
||||
return dict(_PAGE_HELPERS.get(service, {}))
|
||||
|
||||
|
||||
def register_sx_helper(service: str, name: str, source: str) -> None:
|
||||
"""Register an SX-defined helper (from defhelper) for a service."""
|
||||
if service not in _SX_HELPERS:
|
||||
_SX_HELPERS[service] = {}
|
||||
_SX_HELPERS[service][name] = source
|
||||
logger.debug("Registered SX helper %s:%s", service, name)
|
||||
|
||||
|
||||
def get_sx_helpers(service: str) -> dict[str, str]:
|
||||
"""Return SX-defined helpers for a service (name → SX source)."""
|
||||
return dict(_SX_HELPERS.get(service, {}))
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Loading — parse .sx files and collect PageDef instances
|
||||
# ---------------------------------------------------------------------------
|
||||
@@ -179,8 +193,8 @@ def _parse_defpage(expr: list) -> PageDef | None:
|
||||
|
||||
|
||||
def load_page_file(filepath: str, service_name: str) -> list[PageDef]:
|
||||
"""Parse an .sx file and register any defpage definitions."""
|
||||
from .parser import parse_all
|
||||
"""Parse an .sx file and register any defpage/defhelper definitions."""
|
||||
from .parser import parse_all, serialize
|
||||
|
||||
with open(filepath, encoding="utf-8") as f:
|
||||
source = f.read()
|
||||
@@ -189,16 +203,42 @@ def load_page_file(filepath: str, service_name: str) -> list[PageDef]:
|
||||
pages: list[PageDef] = []
|
||||
|
||||
for expr in exprs:
|
||||
if (isinstance(expr, list) and expr
|
||||
and hasattr(expr[0], 'name') and expr[0].name == "defpage"):
|
||||
if not isinstance(expr, list) or not expr:
|
||||
continue
|
||||
head = getattr(expr[0], 'name', None)
|
||||
if head == "defpage":
|
||||
pd = _parse_defpage(expr)
|
||||
if pd:
|
||||
register_page(service_name, pd)
|
||||
pages.append(pd)
|
||||
elif head == "defhelper":
|
||||
_parse_defhelper(expr, service_name, serialize)
|
||||
|
||||
return pages
|
||||
|
||||
|
||||
def _parse_defhelper(expr: list, service_name: str, serialize) -> None:
|
||||
"""Parse (defhelper name (params...) body...) and register as SX helper.
|
||||
|
||||
Translates to a (define name (fn (params...) body...)) SX source string
|
||||
that will be loaded into the OCaml kernel at render time.
|
||||
"""
|
||||
if len(expr) < 4:
|
||||
logger.warning("defhelper: too few forms: %s", expr[:2])
|
||||
return
|
||||
name = expr[1].name if hasattr(expr[1], 'name') else str(expr[1])
|
||||
params = expr[2]
|
||||
body = expr[3:]
|
||||
|
||||
# Build the equivalent define/fn form
|
||||
body_sx = " ".join(serialize(b) for b in body)
|
||||
if len(body) > 1:
|
||||
body_sx = f"(do {body_sx})"
|
||||
params_sx = serialize(params)
|
||||
sx_source = f'(define {name} (fn {params_sx} {body_sx}))'
|
||||
register_sx_helper(service_name, name, sx_source)
|
||||
|
||||
|
||||
def load_page_dir(directory: str, service_name: str) -> list[PageDef]:
|
||||
"""Load all .sx files from a directory and register pages."""
|
||||
import glob as glob_mod
|
||||
|
||||
@@ -142,25 +142,25 @@
|
||||
(define
|
||||
reactive-runtime-nav-items
|
||||
(list
|
||||
(dict :label "Ref" :href "/sx/(applications.(reactive-runtime.ref))")
|
||||
(dict :label "Ref" :href "/sx/(geography.(reactive-runtime.ref))")
|
||||
(dict
|
||||
:label "Foreign FFI"
|
||||
:href "/sx/(applications.(reactive-runtime.foreign))")
|
||||
:href "/sx/(geography.(reactive-runtime.foreign))")
|
||||
(dict
|
||||
:label "State Machines"
|
||||
:href "/sx/(applications.(reactive-runtime.machine))")
|
||||
:href "/sx/(geography.(reactive-runtime.machine))")
|
||||
(dict
|
||||
:label "Commands"
|
||||
:href "/sx/(applications.(reactive-runtime.commands))")
|
||||
:href "/sx/(geography.(reactive-runtime.commands))")
|
||||
(dict
|
||||
:label "Render Loop"
|
||||
:href "/sx/(applications.(reactive-runtime.loop))")
|
||||
:href "/sx/(geography.(reactive-runtime.loop))")
|
||||
(dict
|
||||
:label "Keyed Lists"
|
||||
:href "/sx/(applications.(reactive-runtime.keyed-lists))")
|
||||
:href "/sx/(geography.(reactive-runtime.keyed-lists))")
|
||||
(dict
|
||||
:label "App Shell"
|
||||
:href "/sx/(applications.(reactive-runtime.app-shell))")))
|
||||
:href "/sx/(geography.(reactive-runtime.app-shell))")))
|
||||
|
||||
(define
|
||||
native-browser-nav-items
|
||||
@@ -739,7 +739,7 @@
|
||||
:select-colours "aria-selected:bg-violet-200 aria-selected:text-violet-900"))
|
||||
items)))
|
||||
|
||||
(define sx-nav-tree {:href "/sx/" :children (list {:href "/sx/(geography)" :children (list {:href "/sx/(geography.(reactive))" :children reactive-islands-nav-items :label "Reactive Islands"} {:href "/sx/(geography.(hypermedia))" :children (list {:href "/sx/(geography.(hypermedia.(reference)))" :children reference-nav-items :label "Reference"} {:href "/sx/(geography.(hypermedia.(example)))" :children examples-nav-items :label "Examples"}) :label "Hypermedia Lakes"} {:href "/sx/(geography.(scopes))" :summary "The unified primitive beneath provide, collect!, spreads, and islands. Named scope with downward value, upward accumulation, and a dedup flag." :label "Scopes"} {:href "/sx/(geography.(provide))" :summary "Sugar for scope-with-value. Render-time dynamic scope — the substrate beneath spreads, CSSX, and script collection." :label "Provide / Emit!"} {:href "/sx/(geography.(spreads))" :summary "Child-to-parent communication across render boundaries — spread, collect!, reactive-spread, built on scopes." :label "Spreads"} {:href "/sx/(geography.(marshes))" :children marshes-examples-nav-items :summary "Where reactivity and hypermedia interpenetrate — server writes to signals, reactive transforms reshape server content, client state modifies how hypermedia is interpreted." :label "Marshes"} {:href "/sx/(geography.(isomorphism))" :children isomorphism-nav-items :label "Isomorphism"} {:href "/sx/(geography.(cek))" :children cek-nav-items :label "CEK Machine"}) :label "Geography"} {:href "/sx/(language)" :children (list {:href "/sx/(language.(doc))" :children docs-nav-items :label "Docs"} {:href "/sx/(language.(spec))" :children specs-nav-items :label "Specs"} {:href "/sx/(language.(spec.(explore.evaluator)))" :label "Spec Explorer"} {:href "/sx/(language.(bootstrapper))" :children bootstrappers-nav-items :label "Bootstrappers"} {:href "/sx/(language.(test))" :children testing-nav-items :label "Testing"}) :label "Language"} {:href "/sx/(applications)" :children (list {:href "/sx/(applications.(sx-urls))" :label "SX URLs"} {:href "/sx/(applications.(cssx))" :children cssx-nav-items :label "CSSX"} {:href "/sx/(applications.(protocol))" :children protocols-nav-items :label "Protocols"} {:href "/sx/(applications.(sx-pub))" :label "sx-pub"} {:href "/sx/(applications.(sx-tools))" :label "SX Tools"} {:href "/sx/(applications.(reactive-runtime))" :children reactive-runtime-nav-items :label "Reactive Runtime"}) :label "Applications"} {:href "/sx/(etc)" :children (list {:href "/sx/(etc.(essay))" :children essays-nav-items :label "Essays"} {:href "/sx/(etc.(philosophy))" :children philosophy-nav-items :label "Philosophy"} {:href "/sx/(etc.(plan))" :children plans-nav-items :label "Plans"}) :label "Etc"}) :label "sx"})
|
||||
(define sx-nav-tree {:href "/sx/" :children (list {:href "/sx/(geography)" :children (list {:href "/sx/(geography.(reactive))" :children reactive-islands-nav-items :label "Reactive Islands"} {:href "/sx/(geography.(hypermedia))" :children (list {:href "/sx/(geography.(hypermedia.(reference)))" :children reference-nav-items :label "Reference"} {:href "/sx/(geography.(hypermedia.(example)))" :children examples-nav-items :label "Examples"}) :label "Hypermedia Lakes"} {:href "/sx/(geography.(scopes))" :summary "The unified primitive beneath provide, collect!, spreads, and islands. Named scope with downward value, upward accumulation, and a dedup flag." :label "Scopes"} {:href "/sx/(geography.(provide))" :summary "Sugar for scope-with-value. Render-time dynamic scope — the substrate beneath spreads, CSSX, and script collection." :label "Provide / Emit!"} {:href "/sx/(geography.(spreads))" :summary "Child-to-parent communication across render boundaries — spread, collect!, reactive-spread, built on scopes." :label "Spreads"} {:href "/sx/(geography.(marshes))" :children marshes-examples-nav-items :summary "Where reactivity and hypermedia interpenetrate — server writes to signals, reactive transforms reshape server content, client state modifies how hypermedia is interpreted." :label "Marshes"} {:href "/sx/(geography.(isomorphism))" :children isomorphism-nav-items :label "Isomorphism"} {:href "/sx/(geography.(cek))" :children cek-nav-items :label "CEK Machine"}) :label "Geography"} {:href "/sx/(language)" :children (list {:href "/sx/(language.(doc))" :children docs-nav-items :label "Docs"} {:href "/sx/(language.(spec))" :children specs-nav-items :label "Specs"} {:href "/sx/(language.(spec.(explore.evaluator)))" :label "Spec Explorer"} {:href "/sx/(language.(bootstrapper))" :children bootstrappers-nav-items :label "Bootstrappers"} {:href "/sx/(language.(test))" :children testing-nav-items :label "Testing"}) :label "Language"} {:href "/sx/(applications)" :children (list {:href "/sx/(applications.(sx-urls))" :label "SX URLs"} {:href "/sx/(applications.(cssx))" :children cssx-nav-items :label "CSSX"} {:href "/sx/(applications.(protocol))" :children protocols-nav-items :label "Protocols"} {:href "/sx/(applications.(sx-pub))" :label "sx-pub"} {:href "/sx/(applications.(sx-tools))" :label "SX Tools"} {:href "/sx/(geography.(reactive-runtime))" :children reactive-runtime-nav-items :label "Reactive Runtime"}) :label "Applications"} {:href "/sx/(etc)" :children (list {:href "/sx/(etc.(essay))" :children essays-nav-items :label "Essays"} {:href "/sx/(etc.(philosophy))" :children philosophy-nav-items :label "Philosophy"} {:href "/sx/(etc.(plan))" :children plans-nav-items :label "Plans"}) :label "Etc"}) :label "sx"})
|
||||
|
||||
(define
|
||||
has-descendant-href?
|
||||
@@ -811,3 +811,6 @@
|
||||
i
|
||||
(find-loop (+ i 1))))))
|
||||
(find-loop 0))))
|
||||
|
||||
(define sxtp-nav-items
|
||||
(list (dict :label "SXTP Protocol" :href "/sx/(applications.(sxtp))")))
|
||||
|
||||
@@ -77,7 +77,11 @@
|
||||
:href "/sx/(geography.(cek))"
|
||||
:label "CEK Machine"
|
||||
:children cek-nav-items)
|
||||
(dict :href "/sx/(geography.(capabilities))" :label "Capabilities")))
|
||||
(dict :href "/sx/(geography.(capabilities))" :label "Capabilities")
|
||||
(dict
|
||||
:href "/sx/(geography.(reactive-runtime))"
|
||||
:label "Reactive Runtime"
|
||||
:children reactive-runtime-nav-items)))
|
||||
(dict
|
||||
:href "/sx/(language)"
|
||||
:label "Language"
|
||||
@@ -115,13 +119,10 @@
|
||||
:label "Protocols"
|
||||
:children protocols-nav-items)
|
||||
(dict :href "/sx/(applications.(sx-pub))" :label "sx-pub")
|
||||
(dict
|
||||
:href "/sx/(applications.(reactive-runtime))"
|
||||
:label "Reactive Runtime"
|
||||
:children reactive-runtime-nav-items)
|
||||
(dict
|
||||
:href "/sx/(applications.(native-browser))"
|
||||
:label "Native Browser")))
|
||||
:label "Native Browser")
|
||||
(dict :href "/sx/(applications.(sxtp))" :label "SXTP Protocol")))
|
||||
(dict :href "/sx/(tools)" :label "Tools" :children tools-nav-items)
|
||||
(dict
|
||||
:href "/sx/(etc)"
|
||||
|
||||
@@ -674,3 +674,5 @@
|
||||
|
||||
(define eval-rules (fn (&key title &rest args) (quasiquote (~geography/eval-rules-content))))
|
||||
|
||||
|
||||
(define sxtp (make-page-fn "~applications/sxtp/content" "~applications/sxtp/" nil "-content"))
|
||||
|
||||
340
sx/sx/sxtp.sx
Normal file
340
sx/sx/sxtp.sx
Normal file
@@ -0,0 +1,340 @@
|
||||
(defcomp
|
||||
~applications/sxtp/content
|
||||
()
|
||||
(~docs/page
|
||||
:title "SXTP Protocol"
|
||||
(~docs/section
|
||||
:title "Overview"
|
||||
:id "overview"
|
||||
(p
|
||||
"SXTP — SX Transfer Protocol — is HTTP reimagined where the wire format "
|
||||
(em "is")
|
||||
" the language. Requests, responses, headers, cookies, status conditions, and bodies are all s-expressions. There is no text framing, no content-type negotiation, no URL query-string encoding.")
|
||||
(p "Design principles:")
|
||||
(ul
|
||||
:class "list-disc list-inside space-y-2 mt-2"
|
||||
(li
|
||||
(strong "SX all the way")
|
||||
" — every datum on the wire is a valid SX value")
|
||||
(li
|
||||
(strong "Open verb set")
|
||||
" — any symbol is a legal verb, not just GET/POST/PUT/DELETE")
|
||||
(li
|
||||
(strong "Structured metadata")
|
||||
" — headers and cookies are dicts, not flat strings")
|
||||
(li
|
||||
(strong "Capability-scoped")
|
||||
" — requests declare required capabilities")
|
||||
(li
|
||||
(strong "Content-addressed")
|
||||
" — responses can be cached by hash")
|
||||
(li
|
||||
(strong "Streamable")
|
||||
" — chunked responses are sequences of expressions")))
|
||||
(~docs/section
|
||||
:title "Requests"
|
||||
:id "requests"
|
||||
(p
|
||||
"A request is a list beginning with the symbol "
|
||||
(code "request")
|
||||
". All fields are keyword arguments.")
|
||||
(~docs/code
|
||||
:src (highlight "(request :verb navigate :path \"/\")" "lisp"))
|
||||
(p "Full request with all fields:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(request\n :verb navigate\n :path \"/geography/capabilities\"\n :headers {:accept \"text/sx\" :language \"en\"}\n :cookies {:session \"tok_abc123\" :prefs {:theme \"dark\"}}\n :params {:page 1 :per-page 20}\n :capabilities (fetch query)\n :body nil)"
|
||||
"lisp"))
|
||||
(div
|
||||
:class "overflow-x-auto rounded border border-stone-200 mt-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" "Field")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Description")))
|
||||
(tbody
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":verb")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Symbol — the action to perform (required)"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":path")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"String — resource path (required)"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":headers")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Dict — structured request metadata"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":cookies")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Dict — client state, values can be any SX type"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":params")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Dict — query parameters as typed values"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":capabilities")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"List — capabilities this request requires"))
|
||||
(tr
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" ":body")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Any SX value — request payload"))))))
|
||||
(~docs/section
|
||||
:title "Responses"
|
||||
:id "responses"
|
||||
(p
|
||||
"A response is a list beginning with the symbol "
|
||||
(code "response")
|
||||
".")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(response :status ok\n :headers {:content-type \"text/sx\" :cache :immutable}\n :set-cookie {:session {:value \"tok_xyz\" :max-age 3600 :path \"/\"}}\n :body (page :title \"Home\" (h1 \"Welcome\")))"
|
||||
"lisp"))
|
||||
(p
|
||||
"The body isn't serialized HTML that needs parsing — it's a live component tree the browser evaluates directly."))
|
||||
(~docs/section
|
||||
:title "Verbs"
|
||||
:id "verbs"
|
||||
(p
|
||||
"Unlike HTTP's fixed set, any symbol is a valid verb. Convention defines common verbs; domains add their own.")
|
||||
(div
|
||||
:class "overflow-x-auto rounded border border-stone-200 mt-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" "Verb")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "Purpose")))
|
||||
(tbody
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "navigate")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Retrieve a page for display — analogous to GET for documents"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "fetch")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Retrieve data — analogous to GET for APIs"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "query")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Structured query — body contains a query expression"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "mutate")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Change state — analogous to POST/PUT/PATCH"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "create")
|
||||
(td :class "px-3 py-2 text-stone-600" "Create a new resource"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "delete")
|
||||
(td :class "px-3 py-2 text-stone-600" "Remove a resource"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "subscribe")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Open a streaming channel for real-time updates"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "inspect")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Retrieve metadata about a resource (capabilities, schema)"))
|
||||
(tr
|
||||
(td :class "px-3 py-2 text-stone-700 font-mono" "ping")
|
||||
(td :class "px-3 py-2 text-stone-600" "Liveness check")))))
|
||||
(p :class "mt-4" "Domains define their own verbs freely:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(request :verb publish :path \"/blog/draft-123\")\n(request :verb checkout :path \"/cart\")\n(request :verb render :path \"/artdag/node/abc\" :params {:format \"png\"})\n(request :verb federate :path \"/outbox\" :body (activity ...))"
|
||||
"lisp")))
|
||||
(~docs/section
|
||||
:title "What HTTP got wrong"
|
||||
:id "http-comparison"
|
||||
(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" "HTTP pain")
|
||||
(th :class "px-3 py-2 font-medium text-stone-600" "SXTP answer")))
|
||||
(tbody
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-700"
|
||||
"Fixed verb set (GET/POST/PUT/DELETE)")
|
||||
(td :class "px-3 py-2 text-stone-600" "Any symbol is a verb"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-700"
|
||||
"Headers are flat string pairs")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Headers are dicts — nested, typed"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-700"
|
||||
"Cookies are encoded strings")
|
||||
(td :class "px-3 py-2 text-stone-600" "Cookies are SX values"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-700"
|
||||
"Body requires content-type negotiation")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Body is always SX — rendering is the client's job"))
|
||||
(tr
|
||||
:class "border-b border-stone-100"
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-700"
|
||||
"URL query strings (?a=1&b=2)")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Params are part of the request expression"))
|
||||
(tr
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-700"
|
||||
"Separate mechanisms for streaming")
|
||||
(td
|
||||
:class "px-3 py-2 text-stone-600"
|
||||
"Streaming is just :stream true + chunk sequences"))))))
|
||||
(~docs/section
|
||||
:title "Status and conditions"
|
||||
:id "status"
|
||||
(p
|
||||
"Status is a symbol, not a number. Conditions replace error codes with structured, informative values.")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(response :status not-found\n :body (condition :type resource-not-found\n :path \"/blog/nonexistent\"\n :message \"No such post\"\n :retry false))"
|
||||
"lisp"))
|
||||
(p "Conditions are extensible — domains define their own:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(condition :type payment-declined\n :reason :insufficient-funds\n :provider \"sumup\")"
|
||||
"lisp")))
|
||||
(~docs/section
|
||||
:title "Streaming"
|
||||
:id "streaming"
|
||||
(p
|
||||
"A streaming response sets "
|
||||
(code ":stream true")
|
||||
". The body becomes a sequence of chunk expressions.")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
";; Ordered chunks\n(response :status ok :stream true)\n(chunk :seq 0 :body (tr (td \"Row 1\") (td \"data\")))\n(chunk :seq 1 :body (tr (td \"Row 2\") (td \"data\")))\n(chunk :done true)\n\n;; Server-sent events via subscribe\n(request :verb subscribe :path \"/events/live\")\n\n(event :type new-event :id \"evt-42\"\n :body (div :class \"event-card\" (h3 \"Jazz Night\")))\n(event :type update :id \"evt-42\"\n :body {:attendees 51})\n(event :type heartbeat :time 1711612800)"
|
||||
"lisp")))
|
||||
(~docs/section
|
||||
:title "Capabilities"
|
||||
:id "capabilities"
|
||||
(p
|
||||
"Requests declare the capabilities they need. The server checks these against the session's granted capabilities. Insufficient capabilities produce "
|
||||
(code "(response :status forbidden)")
|
||||
".")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
";; Client declares\n(request :verb query :path \"/events\"\n :capabilities (fetch db:read))\n\n;; Server grants on auth\n(response :status ok\n :set-cookie {:capabilities {:value (fetch query db:read mutate)\n :max-age 86400\n :secure true}})"
|
||||
"lisp"))
|
||||
(p "Inspect what a resource requires:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(request :verb inspect :path \"/cart/checkout\")\n\n(response :status ok\n :body {:required-capabilities (mutate cart:checkout)\n :available-verbs (inspect mutate)\n :params-schema {:shipping-address \"dict\"\n :payment-method \"symbol\"}})"
|
||||
"lisp")))
|
||||
(~docs/section
|
||||
:title "Caching"
|
||||
:id "caching"
|
||||
(p
|
||||
"Content-addressed caching. The response hash "
|
||||
(em "is")
|
||||
" the cache key. No ETags, no Last-Modified — just SX content hashes.")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
";; Server provides hash\n(response :status ok\n :headers {:content-hash \"sha3-abc123...\"\n :cache :immutable}\n :body ...)\n\n;; Client validates\n(request :verb fetch :path \"/geography/capabilities\"\n :headers {:if-match \"sha3-abc123...\"})\n\n(response :status not-modified)"
|
||||
"lisp"))
|
||||
(p
|
||||
"Three cache policies: "
|
||||
(code ":immutable")
|
||||
" (content-addressed, never changes), "
|
||||
(code ":revalidate")
|
||||
" (check hash before using), "
|
||||
(code ":none")
|
||||
" (dynamic content)."))
|
||||
(~docs/section
|
||||
:title "Wire format"
|
||||
:id "wire-format"
|
||||
(p
|
||||
"On the wire, each message is a length-prefixed SX expression. Length is a decimal integer as ASCII, followed by newline. The SX expression is UTF-8 encoded.")
|
||||
(~docs/code
|
||||
:src (highlight "43\n(request :verb ping :path \"/\" :body nil)" "text"))
|
||||
(p
|
||||
"Connections are persistent — multiple request/response pairs on the same connection. Pipelining is allowed. TLS is the transport security layer: "
|
||||
(code "sxtp://")
|
||||
" is plaintext (port 5380), "
|
||||
(code "sxtps://")
|
||||
" is TLS (port 5381)."))
|
||||
(~docs/section
|
||||
:title "URI scheme"
|
||||
:id "uri"
|
||||
(p "The browser translates URIs into request expressions:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"sxtps://blog.rose-ash.com/geography/capabilities\n\n;; becomes\n\n(request :verb navigate\n :path \"/geography/capabilities\"\n :headers {:host \"blog.rose-ash.com\"})"
|
||||
"lisp")))
|
||||
(~docs/section
|
||||
:title "Examples"
|
||||
:id "examples"
|
||||
(p "Page navigation:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(request :verb navigate :path \"/geography/capabilities\"\n :headers {:host \"sx.rose-ash.com\" :accept \"text/sx\"})\n\n(response :status ok\n :headers {:content-type \"text/sx\"\n :content-hash \"sha3-9f2a...\"}\n :body (page :title \"Capabilities\"\n (h1 \"Geography Capabilities\")\n (~capability-list :domain \"geography\")))"
|
||||
"lisp"))
|
||||
(p "Structured query:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(request :verb query :path \"/events\"\n :capabilities (fetch db:read)\n :params {:after \"2026-03-01\" :limit 10}\n :body (filter (events) (fn (e) (> (:attendees e) 50))))\n\n(response :status ok\n :headers {:cache :revalidate}\n :body ((event :id \"evt-42\" :title \"Jazz Night\" :attendees 87)\n (event :id \"evt-55\" :title \"Art Walk\" :attendees 120)))"
|
||||
"lisp"))
|
||||
(p "Creating a resource:")
|
||||
(~docs/code
|
||||
:src (highlight
|
||||
"(request :verb create :path \"/blog/posts\"\n :capabilities (mutate blog:publish)\n :cookies {:session \"tok_abc123\"}\n :body {:title \"SXTP Protocol\"\n :body (article (h1 \"SXTP\") (p \"Everything is SX.\"))\n :tags (\"protocol\" \"sx\" \"web\")})\n\n(response :status created\n :headers {:location \"/blog/posts/sxtp-protocol\"\n :content-hash \"sha3-ff01...\"}\n :body {:id \"post-789\"\n :path \"/blog/posts/sxtp-protocol\"\n :created-at 1711612800})"
|
||||
"lisp")))
|
||||
(~docs/section
|
||||
:title "Specification"
|
||||
:id "spec"
|
||||
(p
|
||||
"The formal specification lives in "
|
||||
(code "applications/sxtp/spec.sx")
|
||||
" — a self-describing SX file where the field definitions are themselves SX data structures that the protocol can introspect."))))
|
||||
Reference in New Issue
Block a user