coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sx-host plan steps 1-2: defhelper + SX config + SXTP spec + nav tools

Browse Source 
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:
giles
2026-03-28 15:18:45 +00:00
parent 27fd470ac8
commit 153f02c672
14 changed files with 734 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

197
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -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")]);