From 153f02c6729fd6260c93dfcedaf4a321d4f3fee7 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 28 Mar 2026 15:18:45 +0000 Subject: [PATCH] sx-host plan steps 1-2: defhelper + SX config + SXTP spec + nav tools MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- _config/app-config.sx | 1 + blog/config/app-config.sx | 1 + cart/config/app-config.sx | 1 + events/config/app-config.sx | 1 + federation/config/app-config.sx | 1 + hosts/ocaml/bin/mcp_tree.ml | 197 +++++++++++++++++- market/config/app-config.sx | 1 + shared/config.py | 119 +++++++++-- shared/sx/ocaml_bridge.py | 33 +++- shared/sx/pages.py | 48 ++++- sx/sx/nav-data.sx | 19 +- sx/sx/nav-tree.sx | 13 +- sx/sx/page-functions.sx | 2 + sx/sx/sxtp.sx | 340 ++++++++++++++++++++++++++++++++ 14 files changed, 734 insertions(+), 43 deletions(-) create mode 100644 _config/app-config.sx create mode 100644 blog/config/app-config.sx create mode 100644 cart/config/app-config.sx create mode 100644 events/config/app-config.sx create mode 100644 federation/config/app-config.sx create mode 100644 market/config/app-config.sx create mode 100644 sx/sx/sxtp.sx diff --git a/_config/app-config.sx b/_config/app-config.sx new file mode 100644 index 00000000..8d551488 --- /dev/null +++ b/_config/app-config.sx @@ -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"}) diff --git a/blog/config/app-config.sx b/blog/config/app-config.sx new file mode 100644 index 00000000..8d551488 --- /dev/null +++ b/blog/config/app-config.sx @@ -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"}) diff --git a/cart/config/app-config.sx b/cart/config/app-config.sx new file mode 100644 index 00000000..8d551488 --- /dev/null +++ b/cart/config/app-config.sx @@ -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"}) diff --git a/events/config/app-config.sx b/events/config/app-config.sx new file mode 100644 index 00000000..8d551488 --- /dev/null +++ b/events/config/app-config.sx @@ -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"}) diff --git a/federation/config/app-config.sx b/federation/config/app-config.sx new file mode 100644 index 00000000..8d551488 --- /dev/null +++ b/federation/config/app-config.sx @@ -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"}) diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml index 5e1c8fdc..501fe143 100644 --- a/hosts/ocaml/bin/mcp_tree.ml +++ b/hosts/ocaml/bin/mcp_tree.ml @@ -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")]); diff --git a/market/config/app-config.sx b/market/config/app-config.sx new file mode 100644 index 00000000..8d551488 --- /dev/null +++ b/market/config/app-config.sx @@ -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"}) diff --git a/shared/config.py b/shared/config.py index edee6317..5d056731 100644 --- a/shared/config.py +++ b/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) diff --git a/shared/sx/ocaml_bridge.py b/shared/sx/ocaml_bridge.py index 7f48b229..547e2dfa 100644 --- a/shared/sx/ocaml_bridge.py +++ b/shared/sx/ocaml_bridge.py @@ -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 diff --git a/shared/sx/pages.py b/shared/sx/pages.py index 221e1a08..e5fd9e84 100644 --- a/shared/sx/pages.py +++ b/shared/sx/pages.py @@ -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 diff --git a/sx/sx/nav-data.sx b/sx/sx/nav-data.sx index 0ee017ae..53a1f9e3 100644 --- a/sx/sx/nav-data.sx +++ b/sx/sx/nav-data.sx @@ -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))"))) diff --git a/sx/sx/nav-tree.sx b/sx/sx/nav-tree.sx index 150da8a1..767c96d6 100644 --- a/sx/sx/nav-tree.sx +++ b/sx/sx/nav-tree.sx @@ -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)" diff --git a/sx/sx/page-functions.sx b/sx/sx/page-functions.sx index 8a224df0..3de6ea80 100644 --- a/sx/sx/page-functions.sx +++ b/sx/sx/page-functions.sx @@ -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")) diff --git a/sx/sx/sxtp.sx b/sx/sx/sxtp.sx new file mode 100644 index 00000000..82327de0 --- /dev/null +++ b/sx/sx/sxtp.sx @@ -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."))))