diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml index 82ec3df8..bb8be8f4 100644 --- a/hosts/ocaml/bin/mcp_tree.ml +++ b/hosts/ocaml/bin/mcp_tree.ml @@ -713,6 +713,139 @@ let rec handle_tool name args = if all_docs = [] then text_result "(no components found)" else text_result (String.concat "\n" all_docs) + | "sx_nav" -> + let mode = (try args |> member "mode" |> to_string with _ -> "list") in + let section_filter = (try Some (args |> member "section" |> to_string) with _ -> None) in + let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found -> + try Sys.getenv "SX_ROOT" with Not_found -> Sys.getcwd () in + let sx_dir = project_dir ^ "/sx/sx" in + (* Extract all nav items from nav-data.sx by parsing and walking the AST *) + let scan_nav () = + let src = try In_channel.with_open_text (sx_dir ^ "/nav-data.sx") In_channel.input_all with _ -> "" in + let items = ref [] in + let rec walk = function + | Dict d -> + (match Hashtbl.find_opt d "href", Hashtbl.find_opt d "label" with + | Some (String href), Some (String label) -> + let summary = match Hashtbl.find_opt d "summary" with Some (String s) -> s | _ -> "" in + items := (href, label, summary) :: !items + | _ -> ()); + Hashtbl.iter (fun _ v -> walk v) d + | List l | ListRef { contents = l } -> List.iter walk l + | _ -> () + in + List.iter walk (try Sx_parser.parse_all src with _ -> []); + List.rev !items + in + let href_section href = + if String.length href > 5 && String.sub href 0 5 = "/sx/(" then + let rest = String.sub href 5 (String.length href - 6) in + match String.index_opt rest '.' with Some i -> String.sub rest 0 i | None -> rest + else "" + in + (* Scan all .sx files under sx_dir for defcomp/defisland *) + let scan_comps () = + let comps = ref [] in + let rec scan dir = + Array.iter (fun e -> + let p = dir ^ "/" ^ e in + if Sys.is_directory p then scan p + else if Filename.check_suffix e ".sx" then + List.iter (function + | List (Symbol "defcomp" :: Symbol n :: _) + | List (Symbol "defisland" :: Symbol n :: _) -> + comps := (n, Filename.basename p) :: !comps + | _ -> () + ) (try Sx_parser.parse_all (In_channel.with_open_text p In_channel.input_all) with _ -> []) + ) (try Sys.readdir dir with _ -> [||]) + in scan sx_dir; !comps + in + let scan_pagefns () = + let src = try In_channel.with_open_text (sx_dir ^ "/page-functions.sx") In_channel.input_all with _ -> "" in + List.filter_map (function + | List [Symbol "define"; Symbol n; _] -> Some n + | _ -> None + ) (try Sx_parser.parse_all src with _ -> []) + in + (match mode with + | "list" -> + let items = scan_nav () in + let lines = List.filter_map (fun (href, label, summary) -> + let sec = href_section href in + match section_filter with + | Some f when f <> sec -> None + | _ -> + let s = if summary = "" then "" else " — " ^ (if String.length summary > 50 then String.sub summary 0 50 ^ "..." else summary) in + Some (Printf.sprintf " %-28s %s%s" label href s) + ) items in + text_result (Printf.sprintf "%d nav items%s\n%s" + (List.length lines) + (match section_filter with Some s -> " in " ^ s | None -> "") + (String.concat "\n" lines)) + | "check" -> + let items = scan_nav () in + let comps = scan_comps () in + let pfns = scan_pagefns () in + let issues = Buffer.create 256 in + let n = ref 0 in + let issue s = incr n; Buffer.add_string issues s; Buffer.add_char issues '\n' in + (* Duplicate hrefs *) + let seen = Hashtbl.create 64 in + List.iter (fun (href, label, _) -> + if Hashtbl.mem seen href then issue (Printf.sprintf "DUP %s (%s)" href label) + else Hashtbl.replace seen href () + ) items; + (* Check page function coverage *) + List.iter (fun (href, label, _) -> + let sec = href_section href in + if sec <> "" && not (List.mem sec pfns) && sec <> "sx" then + issue (Printf.sprintf "WARN no page-fn '%s' for %s (%s)" sec label href) + ) items; + (* Components with -content suffix but no nav *) + let nav_src = try In_channel.with_open_text (sx_dir ^ "/nav-data.sx") In_channel.input_all with _ -> "" in + List.iter (fun (name, file) -> + if String.length name > 8 && + String.sub name (String.length name - 8) 8 = "-content" then + let slug = String.sub name 1 (String.length name - 1) in (* remove ~ *) + let parts = String.split_on_char '/' slug in + let last = List.nth parts (List.length parts - 1) in + let check = String.sub last 0 (String.length last - 8) in (* remove -content *) + if not (try ignore (Str.search_forward (Str.regexp_string check) nav_src 0); true with Not_found -> false) then + issue (Printf.sprintf "INFO %s (%s) — no nav entry" name file) + ) comps; + if !n = 0 then text_result "Nav check: all clear" + else text_result (Printf.sprintf "Nav check: %d issues\n%s" !n (Buffer.contents issues)) + | "add" -> + let title = (try args |> member "title" |> to_string with _ -> "") in + let slug = (try args |> member "slug" |> to_string with _ -> "") in + let sec = (match section_filter with Some s -> s | None -> "applications") in + if title = "" || slug = "" then error_result "title and slug required" + else begin + let comp = Printf.sprintf "~%s/%s/content" sec slug in + let file = sx_dir ^ "/" ^ slug ^ ".sx" in + let href = Printf.sprintf "/sx/(%s.(%s))" sec slug in + if Sys.file_exists file then error_result ("exists: " ^ file) + else begin + (* Component file *) + let src = Printf.sprintf ";;; %s\n\n(defcomp %s ()\n (~docs/page :title \"%s\"\n (~docs/section :title \"Overview\" :id \"overview\"\n (p \"TODO\"))))\n" title comp title in + Out_channel.with_open_text file (fun oc -> output_string oc src); + (* Page function *) + let pf = sx_dir ^ "/page-functions.sx" in + let ps = In_channel.with_open_text pf In_channel.input_all in + Out_channel.with_open_text pf (fun oc -> + output_string oc ps; + Printf.fprintf oc "\n(define %s (make-page-fn \"%s\" \"~%s/%s/\" nil \"-content\"))\n" slug comp sec slug); + (* Nav entry *) + let nf = sx_dir ^ "/nav-data.sx" in + let ns = In_channel.with_open_text nf In_channel.input_all in + Out_channel.with_open_text nf (fun oc -> + output_string oc ns; + Printf.fprintf oc "\n(define %s-nav-items\n (list (dict :label \"%s\" :href \"%s\")))\n" slug title href); + 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)) + | "sx_playwright" -> let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found -> let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in @@ -1373,6 +1506,12 @@ 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)")]); + ("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)")])] + []; 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")]); ("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: run, inspect, diff, hydrate, eval, interact, screenshot, listeners, trace, cdp")]);