Add 5 server inspection MCP tools
- sx_load_check: validate all .sx files parse cleanly (108 files) - sx_env: search defined symbols by pattern/type - sx_handler_list: list registered defhandler forms - sx_page_list: list page functions from page-functions.sx (41 pages) - sx_request: HTTP request to running server, returns status + body These tools help debug silent load failures, missing definitions, and handler routing issues. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1889,6 +1889,209 @@ let rec handle_tool name args =
|
||||
| _ -> "?" in
|
||||
error_result (Printf.sprintf "No rule found for '%s'. Categories: %s" form_name cat_str)))
|
||||
|
||||
(* ================================================================== *)
|
||||
(* Server inspection tools *)
|
||||
(* ================================================================== *)
|
||||
|
||||
| "sx_load_check" ->
|
||||
(* Load all .sx files the HTTP server would load, report errors *)
|
||||
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
|
||||
Filename.dirname spec_dir in
|
||||
let spec_base = project_dir ^ "/spec" in
|
||||
let lib_base = project_dir ^ "/lib" in
|
||||
let web_base = project_dir ^ "/web" in
|
||||
let shared_sx = project_dir ^ "/shared/sx/templates" in
|
||||
let sx_sx =
|
||||
let dp = project_dir ^ "/sx" in
|
||||
let dv = project_dir ^ "/sx/sx" in
|
||||
if Sys.file_exists (dp ^ "/page-functions.sx") then dp else dv in
|
||||
let sx_sxc =
|
||||
let dp = project_dir ^ "/sxc" in
|
||||
let dv = project_dir ^ "/sx/sxc" in
|
||||
if Sys.file_exists dp then dp else dv in
|
||||
let skip_files = ["primitives.sx"; "types.sx"; "boundary.sx";
|
||||
"harness.sx"; "eval-rules.sx"; "vm-inline.sx"] in
|
||||
let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"; "client-libs"] in
|
||||
let errors = Buffer.create 256 in
|
||||
let ok_count = ref 0 in
|
||||
let err_count = ref 0 in
|
||||
let test_env = Sx_types.make_env () in
|
||||
(* Bind minimal stubs so files can define things *)
|
||||
ignore (Sx_types.env_bind test_env "register-special-form!" (NativeFn ("register-special-form!", fun args ->
|
||||
match args with [String _; _] -> Nil | _ -> Nil)));
|
||||
ignore (Sx_types.env_bind test_env "*custom-special-forms*" (Dict (Hashtbl.create 0)));
|
||||
let check_file path =
|
||||
if Sys.file_exists path then begin
|
||||
try
|
||||
let exprs = Sx_parser.parse_file path in
|
||||
ignore (List.length exprs);
|
||||
incr ok_count
|
||||
with e ->
|
||||
incr err_count;
|
||||
Buffer.add_string errors (Printf.sprintf " PARSE ERROR %s: %s\n" (Filename.basename path) (Printexc.to_string e))
|
||||
end in
|
||||
let rec check_dir dir =
|
||||
if Sys.file_exists dir && Sys.is_directory dir then begin
|
||||
let entries = Sys.readdir dir in
|
||||
Array.sort String.compare entries;
|
||||
Array.iter (fun f ->
|
||||
let path = dir ^ "/" ^ f in
|
||||
if Sys.is_directory path then begin
|
||||
if not (List.mem f skip_dirs) then check_dir path
|
||||
end else if Filename.check_suffix f ".sx"
|
||||
&& not (List.mem f skip_files)
|
||||
&& not (String.length f > 5 && String.sub f 0 5 = "test-")
|
||||
&& not (Filename.check_suffix f ".test.sx") then
|
||||
check_file path
|
||||
) entries
|
||||
end in
|
||||
(* Check core files *)
|
||||
List.iter check_file [
|
||||
spec_base ^ "/parser.sx"; spec_base ^ "/render.sx"; spec_base ^ "/signals.sx";
|
||||
lib_base ^ "/compiler.sx";
|
||||
web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
|
||||
web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
|
||||
web_base ^ "/request-handler.sx"; web_base ^ "/page-helpers.sx";
|
||||
];
|
||||
(* Check all dirs *)
|
||||
check_dir lib_base;
|
||||
check_dir shared_sx;
|
||||
check_dir sx_sxc;
|
||||
check_dir sx_sx;
|
||||
if !err_count = 0 then
|
||||
text_result (Printf.sprintf "OK — %d files parse cleanly" !ok_count)
|
||||
else
|
||||
text_result (Printf.sprintf "%d files OK, %d errors:\n%s" !ok_count !err_count (Buffer.contents errors))
|
||||
|
||||
| "sx_env" ->
|
||||
(* Query running server for defined symbols *)
|
||||
let pattern = args |> member "pattern" |> to_string_option |> Option.value ~default:"*" in
|
||||
let type_filter = args |> member "type" |> to_string_option in
|
||||
(* Search the MCP tool's own env *)
|
||||
let e = !env in
|
||||
let matches = ref [] in
|
||||
Hashtbl.iter (fun id v ->
|
||||
let name = Sx_types.unintern id in
|
||||
let type_name = Sx_runtime.type_of v |> Sx_runtime.value_to_str in
|
||||
let matches_pattern =
|
||||
if pattern = "*" then true
|
||||
else if String.length pattern > 0 && pattern.[String.length pattern - 1] = '*' then
|
||||
let prefix = String.sub pattern 0 (String.length pattern - 1) in
|
||||
String.length name >= String.length prefix &&
|
||||
String.sub name 0 (String.length prefix) = prefix
|
||||
else name = pattern in
|
||||
let matches_type = match type_filter with
|
||||
| None -> true | Some t -> type_name = "\"" ^ t ^ "\"" in
|
||||
if matches_pattern && matches_type then
|
||||
matches := (name, type_name) :: !matches
|
||||
) e.bindings;
|
||||
let sorted = List.sort (fun (a,_) (b,_) -> String.compare a b) !matches in
|
||||
let lines = List.map (fun (name, tp) -> Printf.sprintf " %-40s %s" name tp) sorted in
|
||||
text_result (Printf.sprintf "%d matches:\n%s" (List.length sorted) (String.concat "\n" lines))
|
||||
|
||||
| "sx_handler_list" ->
|
||||
(* List all registered defhandler forms *)
|
||||
let e = !env in
|
||||
let handlers = ref [] in
|
||||
Hashtbl.iter (fun id v ->
|
||||
let name = Sx_types.unintern id in
|
||||
if String.length name > 8 && String.sub name 0 8 = "handler:" then begin
|
||||
let handler_name = String.sub name 8 (String.length name - 8) in
|
||||
let method_ = match v with
|
||||
| Dict d -> (match Hashtbl.find_opt d "method" with
|
||||
| Some (String m) -> String.uppercase_ascii m
|
||||
| Some (Keyword m) -> String.uppercase_ascii m
|
||||
| _ -> "GET")
|
||||
| _ -> "?" in
|
||||
let path = match v with
|
||||
| Dict d -> (match Hashtbl.find_opt d "path" with
|
||||
| Some (String p) -> p | _ -> "(no path)")
|
||||
| _ -> "?" in
|
||||
handlers := (handler_name, method_, path) :: !handlers
|
||||
end
|
||||
) e.bindings;
|
||||
let sorted = List.sort (fun (a,_,_) (b,_,_) -> String.compare a b) !handlers in
|
||||
let lines = List.map (fun (name, m, p) ->
|
||||
Printf.sprintf " %-6s %-20s %s" m name p) sorted in
|
||||
if sorted = [] then
|
||||
text_result "No handlers registered. Load handlers/examples.sx first."
|
||||
else
|
||||
text_result (Printf.sprintf "%d handlers:\n%s" (List.length sorted) (String.concat "\n" lines))
|
||||
|
||||
| "sx_page_list" ->
|
||||
(* List all page functions by scanning page-functions.sx *)
|
||||
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
|
||||
Filename.dirname spec_dir in
|
||||
let pf_path =
|
||||
let dp = project_dir ^ "/sx/page-functions.sx" in
|
||||
let dv = project_dir ^ "/sx/sx/page-functions.sx" in
|
||||
if Sys.file_exists dp then dp else dv in
|
||||
if not (Sys.file_exists pf_path) then
|
||||
error_result "page-functions.sx not found"
|
||||
else begin
|
||||
try
|
||||
let exprs = Sx_parser.parse_file pf_path in
|
||||
let pages = List.filter_map (fun expr ->
|
||||
match expr with
|
||||
| List (Symbol "define" :: Symbol name :: _) -> Some name
|
||||
| List (Symbol "define" :: String name :: _) -> Some name
|
||||
| _ -> None
|
||||
) exprs in
|
||||
let lines = List.map (fun name ->
|
||||
Printf.sprintf " /sx/(%s)" name) pages in
|
||||
text_result (Printf.sprintf "%d page functions:\n%s" (List.length pages) (String.concat "\n" lines))
|
||||
with e ->
|
||||
error_result (Printf.sprintf "Parse error: %s" (Printexc.to_string e))
|
||||
end
|
||||
|
||||
| "sx_request" ->
|
||||
(* Simulate HTTP request to running server *)
|
||||
let url = args |> member "url" |> to_string in
|
||||
let method_ = args |> member "method" |> to_string_option |> Option.value ~default:"GET" in
|
||||
let port = 8013 in
|
||||
let path = if String.length url > 0 && url.[0] = '/' then url
|
||||
else if String.length url > 4 && String.sub url 0 4 = "http" then
|
||||
try let i = String.index_from url 10 '/' in
|
||||
String.sub url i (String.length url - i) with Not_found -> url
|
||||
else "/" ^ url in
|
||||
(try
|
||||
let addr = Unix.ADDR_INET (Unix.inet_addr_loopback, port) in
|
||||
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
|
||||
Unix.connect sock addr;
|
||||
let request = Printf.sprintf "%s %s HTTP/1.1\r\nHost: localhost\r\nSX-Request: true\r\nConnection: close\r\n\r\n" method_ path in
|
||||
let _ = Unix.write_substring sock request 0 (String.length request) in
|
||||
let buf = Buffer.create 4096 in
|
||||
let tmp = Bytes.create 4096 in
|
||||
let rec read_all () =
|
||||
let n = try Unix.read sock tmp 0 4096 with _ -> 0 in
|
||||
if n > 0 then begin
|
||||
Buffer.add_subbytes buf tmp 0 n;
|
||||
read_all ()
|
||||
end in
|
||||
read_all ();
|
||||
Unix.close sock;
|
||||
let response = Buffer.contents buf in
|
||||
(* Extract status line and body *)
|
||||
let body_start =
|
||||
let rec find i =
|
||||
if i + 4 > String.length response then 0
|
||||
else if String.sub response i 4 = "\r\n\r\n" then i + 4
|
||||
else find (i + 1) in
|
||||
find 0 in
|
||||
let status_line = try String.sub response 0 (String.index response '\r')
|
||||
with Not_found -> "?" in
|
||||
let body = if body_start > 0 && body_start < String.length response then
|
||||
String.sub response body_start (String.length response - body_start)
|
||||
else response in
|
||||
let body_preview = if String.length body > 2000 then
|
||||
String.sub body 0 2000 ^ "\n... (" ^ string_of_int (String.length body) ^ " bytes total)"
|
||||
else body in
|
||||
text_result (Printf.sprintf "%s\nBody (%d bytes):\n%s" status_line (String.length body) body_preview)
|
||||
with e ->
|
||||
error_result (Printf.sprintf "Connection failed (server running on port %d?): %s" port (Printexc.to_string e)))
|
||||
|
||||
| _ -> error_result ("Unknown tool: " ^ name)
|
||||
|
||||
and write_edit file result =
|
||||
@@ -1970,6 +2173,20 @@ let tool_definitions = `List [
|
||||
("components_only", `Assoc [("type", `String "boolean"); ("description", `String "Show only component entry/exit events (default: false)")])] ["expr"];
|
||||
tool "sx_explain" "Explain SX evaluation rules. Pass a form name (if, let, map, ...) or category (literal, special-form, higher-order, ...)."
|
||||
[("name", `Assoc [("type", `String "string"); ("description", `String "Form name or category to explain")])] ["name"];
|
||||
tool "sx_load_check" "Validate all .sx files that the HTTP server loads. Reports parse errors. No server needed."
|
||||
[] [];
|
||||
tool "sx_env" "Search defined symbols in the MCP environment. Supports wildcard patterns (e.g. \"handler:*\", \"~examples*\")."
|
||||
[("pattern", `Assoc [("type", `String "string"); ("description", `String "Symbol name or pattern (* wildcard). Default: *")]);
|
||||
("type", `Assoc [("type", `String "string"); ("description", `String "Filter by type: component, island, lambda, macro, native")])]
|
||||
[];
|
||||
tool "sx_handler_list" "List all registered defhandler forms with their HTTP methods and paths."
|
||||
[] [];
|
||||
tool "sx_page_list" "List all page functions from page-functions.sx with their URL patterns."
|
||||
[] [];
|
||||
tool "sx_request" "Send an HTTP request to the running SX server (localhost:8013). Returns status + response body."
|
||||
[("url", `Assoc [("type", `String "string"); ("description", `String "URL path (e.g. /sx/(geography)) or full URL")]);
|
||||
("method", `Assoc [("type", `String "string"); ("description", `String "HTTP method: GET (default), POST, PUT, DELETE")])]
|
||||
["url"];
|
||||
tool "sx_deps" "Dependency analysis for a component or file. Shows all referenced symbols and where they're defined."
|
||||
[file_prop;
|
||||
("name", `Assoc [("type", `String "string"); ("description", `String "Specific define/defcomp/defisland to analyze")]);
|
||||
|
||||
Reference in New Issue
Block a user