Refactor MCP tree server: dispatch table, caching, validation, subprocess cleanup
Break up the 1735-line handle_tool match into 45 individual handler functions with hashtable-based dispatch. Add mtime-based file parse caching (AST + CST), consolidated run_command helper replacing 9 bare open_process_in patterns, require_file/require_dir input validation, and pagination (limit/offset) for sx_find_across, sx_comp_list, sx_comp_usage. Also includes pending VM changes: rest-arity support, hyperscript parser, compiler/transpiler updates. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -400,19 +400,40 @@ let call_sx fn_name args =
|
||||
let fn = env_get e fn_name in
|
||||
Sx_ref.cek_call fn (List args)
|
||||
|
||||
(* File parse cache — avoids re-parsing unchanged files *)
|
||||
let _parse_cache : (string, float * value) Hashtbl.t = Hashtbl.create 32
|
||||
let _parse_cst_cache : (string, float * value * Sx_parser.cst_file) Hashtbl.t = Hashtbl.create 32
|
||||
let _max_cache_entries = 64
|
||||
|
||||
let cache_invalidate path =
|
||||
Hashtbl.remove _parse_cache path;
|
||||
Hashtbl.remove _parse_cst_cache path
|
||||
|
||||
let parse_file path =
|
||||
let src = In_channel.with_open_text path In_channel.input_all in
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
List exprs
|
||||
let mtime = (Unix.stat path).Unix.st_mtime in
|
||||
match Hashtbl.find_opt _parse_cache path with
|
||||
| Some (cached_mtime, ast) when cached_mtime = mtime -> ast
|
||||
| _ ->
|
||||
if Hashtbl.length _parse_cache > _max_cache_entries then Hashtbl.clear _parse_cache;
|
||||
let src = In_channel.with_open_text path In_channel.input_all in
|
||||
let ast = List (Sx_parser.parse_all src) in
|
||||
Hashtbl.replace _parse_cache path (mtime, ast);
|
||||
ast
|
||||
|
||||
(* CST-based round-tripping — replaces comment_map machinery.
|
||||
Parse file as CST for lossless writes, project to AST for tree-tools. *)
|
||||
|
||||
(* Parse file → (AST for tree-tools, CST for writing back) *)
|
||||
let parse_file_cst path =
|
||||
let cst = Sx_parser.parse_file_cst path in
|
||||
let ast = List (List.map Sx_cst.cst_to_ast cst.nodes) in
|
||||
(ast, cst)
|
||||
let mtime = (Unix.stat path).Unix.st_mtime in
|
||||
match Hashtbl.find_opt _parse_cst_cache path with
|
||||
| Some (cached_mtime, ast, cst) when cached_mtime = mtime -> (ast, cst)
|
||||
| _ ->
|
||||
if Hashtbl.length _parse_cst_cache > _max_cache_entries then Hashtbl.clear _parse_cst_cache;
|
||||
let cst = Sx_parser.parse_file_cst path in
|
||||
let ast = List (List.map Sx_cst.cst_to_ast cst.nodes) in
|
||||
Hashtbl.replace _parse_cst_cache path (mtime, ast, cst);
|
||||
(ast, cst)
|
||||
|
||||
(* Extract comment text from CST trivia for display in summarise/read_tree *)
|
||||
let extract_cst_comments (cst : Sx_parser.cst_file) =
|
||||
@@ -637,6 +658,7 @@ let write_edit_cst file (cst : Sx_parser.cst_file) result =
|
||||
) new_items in
|
||||
let source = Sx_cst.cst_file_to_source new_cst_nodes cst.trailing_trivia in
|
||||
Out_channel.with_open_text file (fun oc -> output_string oc source);
|
||||
cache_invalidate file;
|
||||
text_result (Printf.sprintf "OK — wrote %d bytes to %s" (String.length source) file)
|
||||
| None ->
|
||||
let err = match Hashtbl.find_opt d "error" with
|
||||
@@ -645,15 +667,56 @@ let write_edit_cst file (cst : Sx_parser.cst_file) result =
|
||||
error_result ("Error: " ^ err))
|
||||
| _ -> error_result "Unexpected result type"
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* Infrastructure helpers *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let run_command cmd =
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let buf = Buffer.create 4096 in
|
||||
(try while true do
|
||||
if Buffer.length buf > 0 then Buffer.add_char buf '\n';
|
||||
Buffer.add_string buf (input_line ic)
|
||||
done with End_of_file -> ());
|
||||
let status = Unix.close_process_in ic in
|
||||
let code = match status with Unix.WEXITED n -> n | _ -> 1 in
|
||||
(code, Buffer.contents buf)
|
||||
|
||||
let require_file args key =
|
||||
let open Yojson.Safe.Util in
|
||||
let path = args |> member key |> to_string in
|
||||
if not (Sys.file_exists path) then
|
||||
raise (Invalid_argument (Printf.sprintf "File not found: %s" path));
|
||||
path
|
||||
|
||||
let require_dir args key =
|
||||
let open Yojson.Safe.Util in
|
||||
let path = args |> member key |> to_string in
|
||||
if not (Sys.file_exists path) then
|
||||
raise (Invalid_argument (Printf.sprintf "Directory not found: %s" path))
|
||||
else if not (Sys.is_directory path) then
|
||||
raise (Invalid_argument (Printf.sprintf "Not a directory: %s" path));
|
||||
path
|
||||
|
||||
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
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* Tool dispatch table *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let tool_handlers : (string, Yojson.Safe.t -> Yojson.Safe.t) Hashtbl.t = Hashtbl.create 64
|
||||
let register name f = Hashtbl.replace tool_handlers name f
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* Tool handlers *)
|
||||
(* ------------------------------------------------------------------ *)
|
||||
|
||||
let handle_tool name args =
|
||||
let handle_sx_read_tree args =
|
||||
let open Yojson.Safe.Util in
|
||||
match name with
|
||||
| "sx_read_tree" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let focus = args |> member "focus" |> to_string_option in
|
||||
let max_depth = to_int_safe (args |> member "max_depth") in
|
||||
@@ -679,24 +742,28 @@ let handle_tool name args =
|
||||
let summary = value_to_string (call_sx "summarise" [tree; Number 2.0]) in
|
||||
text_result (inject_cst_comments (Printf.sprintf ";; File has %d lines — showing depth-2 summary. Use max_depth, max_lines, or focus to control output.\n%s" line_count summary) (extract_cst_comments cst)))
|
||||
|
||||
| "sx_summarise" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_summarise args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let depth = to_int_or ~default:2 (args |> member "depth") in
|
||||
text_result (inject_cst_comments (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) (extract_cst_comments cst))
|
||||
|
||||
| "sx_read_subtree" ->
|
||||
let tree = parse_file (args |> member "file" |> to_string) in
|
||||
let handle_sx_read_subtree args =
|
||||
let open Yojson.Safe.Util in
|
||||
let tree = parse_file (require_file args "file") in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
text_result (value_to_string (call_sx "read-subtree" [tree; path]))
|
||||
|
||||
| "sx_get_context" ->
|
||||
let tree = parse_file (args |> member "file" |> to_string) in
|
||||
let handle_sx_get_context args =
|
||||
let open Yojson.Safe.Util in
|
||||
let tree = parse_file (require_file args "file") in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
text_result (value_to_string (call_sx "get-context" [tree; path]))
|
||||
|
||||
| "sx_find_all" ->
|
||||
let tree = parse_file (args |> member "file" |> to_string) in
|
||||
let handle_sx_find_all args =
|
||||
let open Yojson.Safe.Util in
|
||||
let tree = parse_file (require_file args "file") in
|
||||
let pattern = args |> member "pattern" |> to_string in
|
||||
let results = call_sx "find-all" [tree; String pattern] in
|
||||
let lines = match results with
|
||||
@@ -711,8 +778,9 @@ let handle_tool name args =
|
||||
in
|
||||
text_result (String.concat "\n" lines)
|
||||
|
||||
| "sx_get_siblings" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_get_siblings args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
let output = value_to_string (call_sx "get-siblings" [tree; path]) in
|
||||
@@ -722,40 +790,44 @@ let handle_tool name args =
|
||||
| _ -> false in
|
||||
text_result (if is_top_level then inject_cst_comments output (extract_cst_comments cst) else output)
|
||||
|
||||
| "sx_validate" ->
|
||||
let tree = parse_file (args |> member "file" |> to_string) in
|
||||
let handle_sx_validate args =
|
||||
let tree = parse_file (require_file args "file") in
|
||||
text_result (value_to_string (call_sx "validate" [tree]))
|
||||
|
||||
| "sx_replace_node" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_replace_node args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
let src = args |> member "new_source" |> to_string in
|
||||
write_edit_cst file cst (call_sx "replace-node" [tree; path; String src])
|
||||
|
||||
| "sx_insert_child" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_insert_child args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
let index = to_int_or ~default:0 (args |> member "index") in
|
||||
let src = args |> member "new_source" |> to_string in
|
||||
write_edit_cst file cst (call_sx "insert-child" [tree; path; Number (float_of_int index); String src])
|
||||
|
||||
| "sx_delete_node" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_delete_node args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
write_edit_cst file cst (call_sx "delete-node" [tree; path])
|
||||
|
||||
| "sx_wrap_node" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_wrap_node args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let path = resolve_path tree (args |> member "path" |> to_string) in
|
||||
let wrapper = args |> member "wrapper" |> to_string in
|
||||
write_edit_cst file cst (call_sx "wrap-node" [tree; path; String wrapper])
|
||||
|
||||
| "sx_format_check" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_format_check args =
|
||||
let file = require_file args "file" in
|
||||
let tree = parse_file file in
|
||||
let warnings = call_sx "lint-file" [tree] in
|
||||
(match warnings with
|
||||
@@ -764,7 +836,8 @@ let handle_tool name args =
|
||||
text_result (String.concat "\n" (List.map value_to_string items))
|
||||
| _ -> text_result (value_to_string warnings))
|
||||
|
||||
| "sx_macroexpand" ->
|
||||
let handle_sx_macroexpand args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = args |> member "file" |> to_string_option in
|
||||
let expr_str = args |> member "expr" |> to_string in
|
||||
(* Create a fresh env with file definitions loaded *)
|
||||
@@ -781,39 +854,30 @@ let handle_tool name args =
|
||||
) Nil exprs in
|
||||
text_result (Sx_types.inspect result)
|
||||
|
||||
| "sx_build" ->
|
||||
let handle_sx_build args =
|
||||
let open Yojson.Safe.Util in
|
||||
let target = args |> member "target" |> to_string_option |> Option.value ~default:"js" in
|
||||
let full = args |> member "full" |> to_bool_option |> Option.value ~default:false in
|
||||
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 pd = project_dir () in
|
||||
let cmd = match target with
|
||||
| "ocaml" ->
|
||||
let abs_project = if Filename.is_relative project_dir then Sys.getcwd () ^ "/" ^ project_dir else project_dir in
|
||||
let abs_project = if Filename.is_relative pd then Sys.getcwd () ^ "/" ^ pd else pd in
|
||||
Printf.sprintf "cd %s/hosts/ocaml && eval $(opam env 2>/dev/null) && dune build 2>&1 && cp _build/default/browser/sx_browser.bc.wasm.js %s/shared/static/wasm/sx_browser.bc.wasm.js && cp _build/default/browser/sx_browser.bc.js %s/shared/static/wasm/sx_browser.bc.js && cp -r _build/default/browser/sx_browser.bc.wasm.assets %s/shared/static/wasm/" abs_project abs_project abs_project abs_project
|
||||
| "wasm" ->
|
||||
let abs_project = if Filename.is_relative project_dir then Sys.getcwd () ^ "/" ^ project_dir else project_dir in
|
||||
let abs_project = if Filename.is_relative pd then Sys.getcwd () ^ "/" ^ pd else pd in
|
||||
Printf.sprintf "cd %s && bash hosts/ocaml/browser/build-all.sh 2>&1" abs_project
|
||||
| "js" | _ ->
|
||||
let extra = if full then " --extensions continuations --spec-modules types" else "" in
|
||||
Printf.sprintf "cd %s && python3 hosts/javascript/cli.py%s --output shared/static/scripts/sx-browser.js 2>&1" project_dir extra
|
||||
Printf.sprintf "cd %s && python3 hosts/javascript/cli.py%s --output shared/static/scripts/sx-browser.js 2>&1" pd extra
|
||||
in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let lines = ref [] in
|
||||
(try while true do lines := input_line ic :: !lines done with End_of_file -> ());
|
||||
let status = Unix.close_process_in ic in
|
||||
let output = String.concat "\n" (List.rev !lines) in
|
||||
(match status with
|
||||
| Unix.WEXITED 0 -> text_result (Printf.sprintf "OK — %s build succeeded\n%s" target (String.trim output))
|
||||
| _ -> error_result (Printf.sprintf "%s build failed:\n%s" target output))
|
||||
let (code, output) = run_command cmd in
|
||||
if code = 0 then text_result (Printf.sprintf "OK — %s build succeeded\n%s" target (String.trim output))
|
||||
else error_result (Printf.sprintf "%s build failed:\n%s" target output)
|
||||
|
||||
| "sx_build_bytecode" ->
|
||||
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 sx_dir = project_dir ^ "/shared/static/wasm/sx" in
|
||||
let handle_sx_build_bytecode _args =
|
||||
ignore _args;
|
||||
let pd = project_dir () in
|
||||
let sx_dir = pd ^ "/shared/static/wasm/sx" in
|
||||
let files = [
|
||||
"render.sx"; "core-signals.sx"; "signals.sx"; "deps.sx"; "router.sx";
|
||||
"page-helpers.sx"; "freeze.sx"; "bytecode.sx"; "compiler.sx"; "vm.sx";
|
||||
@@ -905,35 +969,29 @@ let handle_tool name args =
|
||||
else
|
||||
text_result (Printf.sprintf "Bytecode compilation partial\n%s" summary)
|
||||
|
||||
| "sx_test" ->
|
||||
let handle_sx_test args =
|
||||
let open Yojson.Safe.Util in
|
||||
let host = args |> member "host" |> to_string_option |> Option.value ~default:"js" in
|
||||
let full = args |> member "full" |> to_bool_option |> Option.value ~default:false in
|
||||
let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
|
||||
(* Walk up from spec dir to find project root *)
|
||||
let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
|
||||
Filename.dirname spec_dir
|
||||
in
|
||||
let pd = project_dir () in
|
||||
let timeout = to_int_or ~default:300 (args |> member "timeout") in
|
||||
let cmd = match host with
|
||||
| "ocaml" ->
|
||||
(* Use pre-built binary directly — avoids dune rebuild delay.
|
||||
Falls back to dune exec if the binary doesn't exist. *)
|
||||
let exe = Printf.sprintf "%s/hosts/ocaml/_build/default/bin/run_tests.exe" project_dir in
|
||||
let exe = Printf.sprintf "%s/hosts/ocaml/_build/default/bin/run_tests.exe" pd in
|
||||
if Sys.file_exists exe then
|
||||
Printf.sprintf "cd %s/hosts/ocaml && timeout %d %s%s 2>&1"
|
||||
project_dir timeout exe (if full then " --full" else "")
|
||||
pd timeout exe (if full then " --full" else "")
|
||||
else
|
||||
Printf.sprintf "cd %s/hosts/ocaml && eval $(opam env 2>/dev/null) && timeout %d dune exec bin/run_tests.exe%s 2>&1"
|
||||
project_dir timeout (if full then " -- --full" else "")
|
||||
pd timeout (if full then " -- --full" else "")
|
||||
| "js" | _ ->
|
||||
Printf.sprintf "cd %s && timeout %d node hosts/javascript/run_tests.js%s 2>&1"
|
||||
project_dir timeout (if full then " --full" else "")
|
||||
pd timeout (if full then " --full" else "")
|
||||
in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let lines = ref [] in
|
||||
(try while true do lines := input_line ic :: !lines done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
let all_lines = List.rev !lines in
|
||||
let (_code, output) = run_command cmd in
|
||||
let all_lines = String.split_on_char '\n' output in
|
||||
(* Extract summary and failures *)
|
||||
let fails = List.filter (fun l -> let t = String.trim l in
|
||||
String.length t > 5 && String.sub t 0 4 = "FAIL") all_lines in
|
||||
@@ -948,7 +1006,8 @@ let handle_tool name args =
|
||||
in
|
||||
text_result result
|
||||
|
||||
| "sx_pretty_print" ->
|
||||
let handle_sx_pretty_print args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = args |> member "file" |> to_string in
|
||||
let cst = Sx_parser.parse_file_cst file in
|
||||
(* Reformat each node's code while preserving trivia (comments, spacing) *)
|
||||
@@ -971,24 +1030,20 @@ let handle_tool name args =
|
||||
) cst.nodes in
|
||||
let source = Sx_cst.cst_file_to_source reformatted cst.trailing_trivia in
|
||||
Out_channel.with_open_text file (fun oc -> output_string oc source);
|
||||
cache_invalidate file;
|
||||
text_result (Printf.sprintf "OK — reformatted %s (%d bytes, %d forms)" file (String.length source) (List.length cst.nodes))
|
||||
|
||||
| "sx_changed" ->
|
||||
let handle_sx_changed args =
|
||||
let open Yojson.Safe.Util in
|
||||
let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in
|
||||
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 cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" project_dir base_ref in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let files = ref [] in
|
||||
(try while true do files := input_line ic :: !files done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
let changed = List.rev !files in
|
||||
let pd = project_dir () in
|
||||
let cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" pd base_ref in
|
||||
let (_code, output) = run_command cmd in
|
||||
let changed = if output = "" then [] else String.split_on_char '\n' output in
|
||||
if changed = [] then text_result (Printf.sprintf "No .sx files changed since %s" base_ref)
|
||||
else begin
|
||||
let lines = List.map (fun rel ->
|
||||
let full = Filename.concat project_dir rel in
|
||||
let full = Filename.concat pd rel in
|
||||
try
|
||||
let tree = parse_file full in
|
||||
let summary = value_to_string (call_sx "summarise" [tree; Number 1.0]) in
|
||||
@@ -998,29 +1053,20 @@ let handle_tool name args =
|
||||
text_result (String.concat "\n\n" lines)
|
||||
end
|
||||
|
||||
| "sx_diff_branch" ->
|
||||
let handle_sx_diff_branch args =
|
||||
let open Yojson.Safe.Util in
|
||||
let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in
|
||||
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 cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" project_dir base_ref in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let files = ref [] in
|
||||
(try while true do files := input_line ic :: !files done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
let changed = List.rev !files in
|
||||
let pd = project_dir () in
|
||||
let cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" pd base_ref in
|
||||
let (_code, output) = run_command cmd in
|
||||
let changed = if output = "" then [] else String.split_on_char '\n' output in
|
||||
if changed = [] then text_result (Printf.sprintf "No .sx files changed since %s" base_ref)
|
||||
else begin
|
||||
let lines = List.filter_map (fun rel ->
|
||||
let full = Filename.concat project_dir rel in
|
||||
let full = Filename.concat pd rel in
|
||||
(* Get the base version via git show *)
|
||||
let base_cmd = Printf.sprintf "cd %s && git show %s:%s 2>/dev/null" project_dir base_ref rel in
|
||||
let ic2 = Unix.open_process_in base_cmd in
|
||||
let base_lines = ref [] in
|
||||
(try while true do base_lines := input_line ic2 :: !base_lines done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic2);
|
||||
let base_src = String.concat "\n" (List.rev !base_lines) in
|
||||
let base_cmd = Printf.sprintf "cd %s && git show %s:%s 2>/dev/null" pd base_ref rel in
|
||||
let (_base_code, base_src) = run_command base_cmd in
|
||||
try
|
||||
let tree_b = parse_file full in
|
||||
if base_src = "" then
|
||||
@@ -1038,13 +1084,11 @@ let handle_tool name args =
|
||||
else text_result (String.concat "\n\n" lines)
|
||||
end
|
||||
|
||||
| "sx_blame" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_blame args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let path_str_arg = args |> member "path" |> to_string_option in
|
||||
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 pd = project_dir () in
|
||||
(* Get the node's source span by parsing and finding line numbers *)
|
||||
let tree = parse_file file in
|
||||
let target_src = match path_str_arg with
|
||||
@@ -1055,7 +1099,7 @@ let handle_tool name args =
|
||||
else Some (Sx_types.inspect node)
|
||||
| None -> None
|
||||
in
|
||||
let rel_file = relative_path ~base:project_dir file in
|
||||
let rel_file = relative_path ~base:pd file in
|
||||
let cmd = match target_src with
|
||||
| Some src ->
|
||||
(* Find the line range containing this source fragment *)
|
||||
@@ -1064,18 +1108,15 @@ let handle_tool name args =
|
||||
if c = '(' || c = ')' || c = '[' || c = ']' || c = '.' || c = '*' || c = '+' || c = '?' || c = '{' || c = '}' || c = '\\' || c = '|' || c = '^' || c = '$'
|
||||
then Printf.sprintf "\\%c" c else String.make 1 c
|
||||
) (String.to_seq first_line))) in
|
||||
Printf.sprintf "cd %s && git blame -L '/%s/,+10' -- %s 2>/dev/null || git blame -- %s 2>/dev/null | head -20" project_dir escaped rel_file rel_file
|
||||
Printf.sprintf "cd %s && git blame -L '/%s/,+10' -- %s 2>/dev/null || git blame -- %s 2>/dev/null | head -20" pd escaped rel_file rel_file
|
||||
| None ->
|
||||
Printf.sprintf "cd %s && git blame -- %s 2>/dev/null | head -30" project_dir rel_file
|
||||
Printf.sprintf "cd %s && git blame -- %s 2>/dev/null | head -30" pd rel_file
|
||||
in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let lines = ref [] in
|
||||
(try while true do lines := input_line ic :: !lines done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
text_result (String.concat "\n" (List.rev !lines))
|
||||
let (_code, output) = run_command cmd in
|
||||
text_result output
|
||||
|
||||
| "sx_doc_gen" ->
|
||||
let dir = args |> member "dir" |> to_string in
|
||||
let handle_sx_doc_gen args =
|
||||
let dir = require_dir args "dir" in
|
||||
let files = glob_sx_files dir in
|
||||
let strip_comment_prefix text =
|
||||
let lines = String.split_on_char '\n' text in
|
||||
@@ -1152,7 +1193,8 @@ let handle_tool name args =
|
||||
if all_docs = [] then text_result "(no components found)"
|
||||
else text_result (String.concat "\n" all_docs)
|
||||
|
||||
| "sx_nav" ->
|
||||
let handle_sx_nav args =
|
||||
let open Yojson.Safe.Util in
|
||||
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 ->
|
||||
@@ -1278,18 +1320,21 @@ let handle_tool name args =
|
||||
(* 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);
|
||||
cache_invalidate file;
|
||||
(* 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);
|
||||
cache_invalidate pf;
|
||||
(* 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);
|
||||
cache_invalidate nf;
|
||||
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
|
||||
@@ -1328,6 +1373,7 @@ let handle_tool name args =
|
||||
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);
|
||||
cache_invalidate nf;
|
||||
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 *)
|
||||
@@ -1362,14 +1408,17 @@ let handle_tool name args =
|
||||
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
|
||||
if ts2 <> ts then begin
|
||||
Out_channel.with_open_text tf (fun oc -> output_string oc ts2);
|
||||
cache_invalidate tf
|
||||
end;
|
||||
(* 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);
|
||||
cache_invalidate pf;
|
||||
log (Printf.sprintf "page-functions.sx: removed define %s" slug)
|
||||
end;
|
||||
text_result (Printf.sprintf "Deleted %s:\n%s" slug (Buffer.contents changes))
|
||||
@@ -1394,6 +1443,7 @@ let handle_tool name args =
|
||||
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);
|
||||
cache_invalidate nf;
|
||||
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 *)
|
||||
@@ -1466,6 +1516,7 @@ let handle_tool name args =
|
||||
result))
|
||||
in
|
||||
Out_channel.with_open_text tf (fun oc -> output_string oc ts3);
|
||||
cache_invalidate tf;
|
||||
(* 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
|
||||
@@ -1474,17 +1525,16 @@ let handle_tool name args =
|
||||
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);
|
||||
cache_invalidate pf;
|
||||
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 ->
|
||||
let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
|
||||
Filename.dirname spec_dir
|
||||
in
|
||||
let handle_sx_playwright args =
|
||||
let open Yojson.Safe.Util in
|
||||
let pd = project_dir () in
|
||||
let spec = args |> member "spec" |> to_string_option in
|
||||
let mode = args |> member "mode" |> to_string_option in
|
||||
let url = args |> member "url" |> to_string_option in
|
||||
@@ -1502,12 +1552,9 @@ let handle_tool name args =
|
||||
if not use_inspector then begin
|
||||
(* Original spec runner *)
|
||||
let spec_arg = match spec with Some s -> " " ^ s | None -> "" in
|
||||
let cmd = Printf.sprintf "cd %s/tests/playwright && npx playwright test%s --reporter=line 2>&1" project_dir spec_arg in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let lines = ref [] in
|
||||
(try while true do lines := input_line ic :: !lines done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
let all_lines = List.rev !lines in
|
||||
let cmd = Printf.sprintf "cd %s/tests/playwright && npx playwright test%s --reporter=line 2>&1" pd spec_arg in
|
||||
let (_code, output) = run_command cmd in
|
||||
let all_lines = String.split_on_char '\n' output in
|
||||
(* Count passed/failed/skipped from the summary line *)
|
||||
let summary = List.find_opt (fun l ->
|
||||
try let _ = Str.search_forward (Str.regexp "passed\\|failed") l 0 in true
|
||||
@@ -1560,12 +1607,8 @@ let handle_tool name args =
|
||||
let args_json = Yojson.Basic.to_string inspector_args in
|
||||
(* Single-quote shell wrapping — escape any literal single quotes in JSON *)
|
||||
let shell_safe = String.concat "'\\''" (String.split_on_char '\'' args_json) in
|
||||
let cmd = Printf.sprintf "cd %s && node tests/playwright/sx-inspect.js '%s' 2>&1" project_dir shell_safe in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let lines = ref [] in
|
||||
(try while true do lines := input_line ic :: !lines done with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
let raw = String.concat "\n" (List.rev !lines) in
|
||||
let cmd = Printf.sprintf "cd %s && node tests/playwright/sx-inspect.js '%s' 2>&1" pd shell_safe in
|
||||
let (_code, raw) = run_command cmd in
|
||||
(* Try to parse as JSON and format nicely *)
|
||||
try
|
||||
let json = Yojson.Basic.from_string raw in
|
||||
@@ -1575,7 +1618,8 @@ let handle_tool name args =
|
||||
text_result raw
|
||||
end
|
||||
|
||||
| "sx_harness_eval" ->
|
||||
let handle_sx_harness_eval args =
|
||||
let open Yojson.Safe.Util in
|
||||
let expr_str = args |> member "expr" |> to_string in
|
||||
let mock_str = args |> member "mock" |> to_string_option in
|
||||
let file = args |> member "file" |> to_string_option in
|
||||
@@ -1637,8 +1681,9 @@ let handle_tool name args =
|
||||
in
|
||||
text_result (Printf.sprintf "Result: %s%s%s" (Sx_types.inspect result) log_str warn_str)
|
||||
|
||||
| "sx_write_file" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_write_file args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let source = args |> member "source" |> to_string in
|
||||
(* Validate by parsing as CST — preserves comments and formatting *)
|
||||
(try
|
||||
@@ -1665,12 +1710,14 @@ let handle_tool name args =
|
||||
) cst.nodes in
|
||||
let output = Sx_cst.cst_file_to_source reformatted cst.trailing_trivia in
|
||||
Out_channel.with_open_text file (fun oc -> output_string oc output);
|
||||
cache_invalidate file;
|
||||
text_result (Printf.sprintf "OK — wrote %d bytes (%d top-level forms) to %s" (String.length output) (List.length cst.nodes) file)
|
||||
end
|
||||
with e -> error_result (Printf.sprintf "Parse error — file not written: %s" (Printexc.to_string e)))
|
||||
|
||||
| "sx_rename_symbol" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_rename_symbol args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let old_name = args |> member "old_name" |> to_string in
|
||||
let new_name = args |> member "new_name" |> to_string in
|
||||
@@ -1684,8 +1731,9 @@ let handle_tool name args =
|
||||
text_result (Printf.sprintf "Renamed %s occurrences of '%s' → '%s' in %s" count_str old_name new_name file)
|
||||
| other -> other)
|
||||
|
||||
| "sx_replace_by_pattern" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_replace_by_pattern args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let pattern = args |> member "pattern" |> to_string in
|
||||
let src = args |> member "new_source" |> to_string in
|
||||
@@ -1695,16 +1743,18 @@ let handle_tool name args =
|
||||
else
|
||||
write_edit_cst file cst (call_sx "replace-by-pattern" [tree; String pattern; String src])
|
||||
|
||||
| "sx_insert_near" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_insert_near args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let tree, cst = parse_file_cst file in
|
||||
let pattern = args |> member "pattern" |> to_string in
|
||||
let position = args |> member "position" |> to_string_option |> Option.value ~default:"after" in
|
||||
let src = args |> member "new_source" |> to_string in
|
||||
write_edit_cst file cst (call_sx "insert-near-pattern" [tree; String pattern; String position; String src])
|
||||
|
||||
| "sx_rename_across" ->
|
||||
let dir = args |> member "dir" |> to_string in
|
||||
let handle_sx_rename_across args =
|
||||
let open Yojson.Safe.Util in
|
||||
let dir = require_dir args "dir" in
|
||||
let old_name = args |> member "old_name" |> to_string in
|
||||
let new_name = args |> member "new_name" |> to_string in
|
||||
let dry_run = args |> member "dry_run" |> to_bool_option |> Option.value ~default:false in
|
||||
@@ -1730,8 +1780,11 @@ let handle_tool name args =
|
||||
if results = [] then text_result (Printf.sprintf "No occurrences of '%s' found" old_name)
|
||||
else text_result (String.concat "\n" results)
|
||||
|
||||
| "sx_comp_list" ->
|
||||
let dir = args |> member "dir" |> to_string in
|
||||
let handle_sx_comp_list args =
|
||||
let open Yojson.Safe.Util in
|
||||
let dir = require_dir args "dir" in
|
||||
let limit = to_int_or ~default:200 (args |> member "limit") in
|
||||
let offset = to_int_or ~default:0 (args |> member "offset") in
|
||||
let files = glob_sx_files dir in
|
||||
let all_lines = List.concat_map (fun path ->
|
||||
let rel = relative_path ~base:dir path in
|
||||
@@ -1754,10 +1807,16 @@ let handle_tool name args =
|
||||
with _ -> []
|
||||
) files in
|
||||
if all_lines = [] then text_result "(no definitions found)"
|
||||
else text_result (Printf.sprintf "%-10s %-40s %-50s %s\n%s" "TYPE" "NAME" "FILE" "PARAMS" (String.concat "\n" all_lines))
|
||||
else
|
||||
let total = List.length all_lines in
|
||||
let page = all_lines |> List.filteri (fun i _ -> i >= offset && i < offset + limit) in
|
||||
text_result (Printf.sprintf "%-10s %-40s %-50s %s (showing %d-%d of %d)\n%s" "TYPE" "NAME" "FILE" "PARAMS" offset (offset + List.length page) total (String.concat "\n" page))
|
||||
|
||||
| "sx_find_across" ->
|
||||
let dir = args |> member "dir" |> to_string in
|
||||
let handle_sx_find_across args =
|
||||
let open Yojson.Safe.Util in
|
||||
let dir = require_dir args "dir" in
|
||||
let limit = to_int_or ~default:200 (args |> member "limit") in
|
||||
let offset = to_int_or ~default:0 (args |> member "offset") in
|
||||
let pattern = args |> member "pattern" |> to_string in
|
||||
let files = glob_sx_files dir in
|
||||
let all_lines = List.concat_map (fun path ->
|
||||
@@ -1777,17 +1836,23 @@ let handle_tool name args =
|
||||
with _ -> []
|
||||
) files in
|
||||
if all_lines = [] then text_result "(no matches)"
|
||||
else text_result (String.concat "\n" all_lines)
|
||||
else
|
||||
let total = List.length all_lines in
|
||||
let page = all_lines |> List.filteri (fun i _ -> i >= offset && i < offset + limit) in
|
||||
text_result (Printf.sprintf "(showing %d-%d of %d)\n%s" offset (offset + List.length page) total (String.concat "\n" page))
|
||||
|
||||
| "sx_diff" ->
|
||||
let file_a = args |> member "file_a" |> to_string in
|
||||
let file_b = args |> member "file_b" |> to_string in
|
||||
let handle_sx_diff args =
|
||||
let file_a = require_file args "file_a" in
|
||||
let file_b = require_file args "file_b" in
|
||||
let tree_a = parse_file file_a in
|
||||
let tree_b = parse_file file_b in
|
||||
text_result (value_to_string (call_sx "tree-diff" [tree_a; tree_b]))
|
||||
|
||||
| "sx_comp_usage" ->
|
||||
let dir = args |> member "dir" |> to_string in
|
||||
let handle_sx_comp_usage args =
|
||||
let open Yojson.Safe.Util in
|
||||
let dir = require_dir args "dir" in
|
||||
let limit = to_int_or ~default:200 (args |> member "limit") in
|
||||
let offset = to_int_or ~default:0 (args |> member "offset") in
|
||||
let name = args |> member "name" |> to_string in
|
||||
let files = glob_sx_files dir in
|
||||
let all_lines = List.concat_map (fun path ->
|
||||
@@ -1807,9 +1872,13 @@ let handle_tool name args =
|
||||
with _ -> []
|
||||
) files in
|
||||
if all_lines = [] then text_result "(no usages found)"
|
||||
else text_result (String.concat "\n" all_lines)
|
||||
else
|
||||
let total = List.length all_lines in
|
||||
let page = all_lines |> List.filteri (fun i _ -> i >= offset && i < offset + limit) in
|
||||
text_result (Printf.sprintf "(showing %d-%d of %d)\n%s" offset (offset + List.length page) total (String.concat "\n" page))
|
||||
|
||||
| "sx_eval" ->
|
||||
let handle_sx_eval args =
|
||||
let open Yojson.Safe.Util in
|
||||
let expr_str = args |> member "expr" |> to_string in
|
||||
let exprs = Sx_parser.parse_all expr_str in
|
||||
let e = !env in
|
||||
@@ -1818,7 +1887,8 @@ let handle_tool name args =
|
||||
) Nil exprs in
|
||||
text_result (Sx_runtime.value_to_str result)
|
||||
|
||||
| "sx_guard" ->
|
||||
let handle_sx_guard args =
|
||||
let open Yojson.Safe.Util in
|
||||
let expr_str = args |> member "expr" |> to_string in
|
||||
let file = try Some (args |> member "file" |> to_string) with _ -> None in
|
||||
let e = !env in
|
||||
@@ -1843,7 +1913,8 @@ let handle_tool name args =
|
||||
String.concat "\n" (List.rev_map (fun c -> " - " ^ c) cs) in
|
||||
text_result (Sx_runtime.value_to_str !result ^ cond_lines)
|
||||
|
||||
| "sx_render_trace" ->
|
||||
let handle_sx_render_trace args =
|
||||
let open Yojson.Safe.Util in
|
||||
let expr_str = args |> member "expr" |> to_string in
|
||||
let file = try Some (args |> member "file" |> to_string) with _ -> None in
|
||||
let e = !env in
|
||||
@@ -1872,7 +1943,8 @@ let handle_tool name args =
|
||||
Buffer.add_string trace (Printf.sprintf "← %s\n" result_str);
|
||||
text_result (Printf.sprintf "Result: %s\n\nRender trace:\n%s" result (Buffer.contents trace))
|
||||
|
||||
| "sx_trace" ->
|
||||
let handle_sx_trace args =
|
||||
let open Yojson.Safe.Util in
|
||||
let expr_str = args |> member "expr" |> to_string in
|
||||
let max_steps = to_int_or ~default:200 (args |> member "max_steps") in
|
||||
let file = try Some (args |> member "file" |> to_string) with _ -> None in
|
||||
@@ -1986,8 +2058,9 @@ let handle_tool name args =
|
||||
text_result (Printf.sprintf "Result: %s\n\nTrace (%d steps):\n%s"
|
||||
final_val !step_count (Buffer.contents steps))
|
||||
|
||||
| "sx_deps" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let handle_sx_deps args =
|
||||
let open Yojson.Safe.Util in
|
||||
let file = require_file args "file" in
|
||||
let name = try Some (args |> member "name" |> to_string) with _ -> None in
|
||||
let dir = try args |> member "dir" |> to_string with _ ->
|
||||
try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
|
||||
@@ -2073,7 +2146,8 @@ let handle_tool name args =
|
||||
text_result (Printf.sprintf "%s\n%d symbols referenced:\n%s%s"
|
||||
header (List.length sym_names) (String.concat "\n" lines) use_str)
|
||||
|
||||
| "sx_build_manifest" ->
|
||||
let handle_sx_build_manifest args =
|
||||
let open Yojson.Safe.Util in
|
||||
let target = (try args |> member "target" |> to_string with _ -> "js") in
|
||||
(match target with
|
||||
| "ocaml" ->
|
||||
@@ -2122,18 +2196,14 @@ let handle_tool name args =
|
||||
) ["native"; "lambda"; "macro"; "component"; "island"; "value"];
|
||||
text_result (Buffer.contents sections)
|
||||
| _ ->
|
||||
let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
|
||||
try Sys.getenv "PWD" with Not_found -> "." in
|
||||
let pd = project_dir () in
|
||||
let cmd = Printf.sprintf "cd %s && python3 hosts/javascript/manifest.py 2>&1"
|
||||
(Filename.quote project_dir) in
|
||||
let ic = Unix.open_process_in cmd in
|
||||
let buf = Buffer.create 4096 in
|
||||
(try while true do Buffer.add_string buf (input_line ic ^ "\n") done
|
||||
with End_of_file -> ());
|
||||
ignore (Unix.close_process_in ic);
|
||||
text_result (Buffer.contents buf))
|
||||
(Filename.quote pd) in
|
||||
let (_code, output) = run_command cmd in
|
||||
text_result output)
|
||||
|
||||
| "sx_explain" ->
|
||||
let handle_sx_explain args =
|
||||
let open Yojson.Safe.Util in
|
||||
let form_name = args |> member "name" |> to_string in
|
||||
let e = !env in
|
||||
let result = try
|
||||
@@ -2184,22 +2254,21 @@ let handle_tool name args =
|
||||
(* Server inspection tools *)
|
||||
(* ================================================================== *)
|
||||
|
||||
| "sx_load_check" ->
|
||||
let handle_sx_load_check _args =
|
||||
ignore _args;
|
||||
(* 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 pd = project_dir () in
|
||||
let spec_base = pd ^ "/spec" in
|
||||
let lib_base = pd ^ "/lib" in
|
||||
let web_base = pd ^ "/web" in
|
||||
let shared_sx = pd ^ "/shared/sx/templates" in
|
||||
let sx_sx =
|
||||
let dp = project_dir ^ "/sx" in
|
||||
let dv = project_dir ^ "/sx/sx" in
|
||||
let dp = pd ^ "/sx" in
|
||||
let dv = pd ^ "/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
|
||||
let dp = pd ^ "/sxc" in
|
||||
let dv = pd ^ "/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
|
||||
@@ -2255,7 +2324,8 @@ let handle_tool name args =
|
||||
else
|
||||
text_result (Printf.sprintf "%d files OK, %d errors:\n%s" !ok_count !err_count (Buffer.contents errors))
|
||||
|
||||
| "sx_env" ->
|
||||
let handle_sx_env args =
|
||||
let open Yojson.Safe.Util in
|
||||
(* 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
|
||||
@@ -2281,7 +2351,8 @@ let handle_tool name args =
|
||||
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" ->
|
||||
let handle_sx_handler_list _args =
|
||||
ignore _args;
|
||||
(* List all registered defhandler forms *)
|
||||
let e = !env in
|
||||
let handlers = ref [] in
|
||||
@@ -2310,14 +2381,13 @@ let handle_tool name args =
|
||||
else
|
||||
text_result (Printf.sprintf "%d handlers:\n%s" (List.length sorted) (String.concat "\n" lines))
|
||||
|
||||
| "sx_page_list" ->
|
||||
let handle_sx_page_list _args =
|
||||
ignore _args;
|
||||
(* 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 pd = project_dir () in
|
||||
let pf_path =
|
||||
let dp = project_dir ^ "/sx/page-functions.sx" in
|
||||
let dv = project_dir ^ "/sx/sx/page-functions.sx" in
|
||||
let dp = pd ^ "/sx/page-functions.sx" in
|
||||
let dv = pd ^ "/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"
|
||||
@@ -2337,7 +2407,8 @@ let handle_tool name args =
|
||||
error_result (Printf.sprintf "Parse error: %s" (Printexc.to_string e))
|
||||
end
|
||||
|
||||
| "sx_request" ->
|
||||
let handle_sx_request args =
|
||||
let open Yojson.Safe.Util in
|
||||
(* 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
|
||||
@@ -2383,7 +2454,62 @@ let handle_tool name args =
|
||||
with e ->
|
||||
error_result (Printf.sprintf "Connection failed (server running on port %d?): %s" port (Printexc.to_string e)))
|
||||
|
||||
| _ -> error_result ("Unknown tool: " ^ name)
|
||||
let handle_tool name args =
|
||||
match Hashtbl.find_opt tool_handlers name with
|
||||
| Some handler ->
|
||||
(try handler args
|
||||
with Invalid_argument msg -> error_result msg
|
||||
| e -> error_result ("Error: " ^ Printexc.to_string e))
|
||||
| None -> error_result ("Unknown tool: " ^ name)
|
||||
|
||||
let () =
|
||||
register "sx_read_tree" handle_sx_read_tree;
|
||||
register "sx_summarise" handle_sx_summarise;
|
||||
register "sx_read_subtree" handle_sx_read_subtree;
|
||||
register "sx_get_context" handle_sx_get_context;
|
||||
register "sx_find_all" handle_sx_find_all;
|
||||
register "sx_get_siblings" handle_sx_get_siblings;
|
||||
register "sx_validate" handle_sx_validate;
|
||||
register "sx_replace_node" handle_sx_replace_node;
|
||||
register "sx_insert_child" handle_sx_insert_child;
|
||||
register "sx_delete_node" handle_sx_delete_node;
|
||||
register "sx_wrap_node" handle_sx_wrap_node;
|
||||
register "sx_format_check" handle_sx_format_check;
|
||||
register "sx_macroexpand" handle_sx_macroexpand;
|
||||
register "sx_build" handle_sx_build;
|
||||
register "sx_build_bytecode" handle_sx_build_bytecode;
|
||||
register "sx_test" handle_sx_test;
|
||||
register "sx_pretty_print" handle_sx_pretty_print;
|
||||
register "sx_changed" handle_sx_changed;
|
||||
register "sx_diff_branch" handle_sx_diff_branch;
|
||||
register "sx_blame" handle_sx_blame;
|
||||
register "sx_doc_gen" handle_sx_doc_gen;
|
||||
register "sx_nav" handle_sx_nav;
|
||||
register "sx_playwright" handle_sx_playwright;
|
||||
register "sx_harness_eval" handle_sx_harness_eval;
|
||||
register "sx_write_file" handle_sx_write_file;
|
||||
register "sx_rename_symbol" handle_sx_rename_symbol;
|
||||
register "sx_replace_by_pattern" handle_sx_replace_by_pattern;
|
||||
register "sx_insert_near" handle_sx_insert_near;
|
||||
register "sx_rename_across" handle_sx_rename_across;
|
||||
register "sx_comp_list" handle_sx_comp_list;
|
||||
register "sx_find_across" handle_sx_find_across;
|
||||
register "sx_diff" handle_sx_diff;
|
||||
register "sx_comp_usage" handle_sx_comp_usage;
|
||||
register "sx_eval" handle_sx_eval;
|
||||
register "sx_guard" handle_sx_guard;
|
||||
register "sx_render_trace" handle_sx_render_trace;
|
||||
register "sx_trace" handle_sx_trace;
|
||||
register "sx_deps" handle_sx_deps;
|
||||
register "sx_build_manifest" handle_sx_build_manifest;
|
||||
register "sx_explain" handle_sx_explain;
|
||||
register "sx_load_check" handle_sx_load_check;
|
||||
register "sx_env" handle_sx_env;
|
||||
register "sx_handler_list" handle_sx_handler_list;
|
||||
register "sx_page_list" handle_sx_page_list;
|
||||
register "sx_request" handle_sx_request;
|
||||
()
|
||||
|
||||
|
||||
(* ------------------------------------------------------------------ *)
|
||||
(* MCP tool definitions *)
|
||||
@@ -2465,12 +2591,18 @@ let tool_definitions = `List [
|
||||
("dir", `Assoc [("type", `String "string"); ("description", `String "Directory to search for definitions (default: project root)")])] ["file"];
|
||||
tool "sx_build_manifest" "Show build manifest: which modules, primitives, adapters, and exports are included in a JS or OCaml build."
|
||||
[("target", `Assoc [("type", `String "string"); ("description", `String "Build target: \"js\" (default) or \"ocaml\"")])] [];
|
||||
tool "sx_find_across" "Search for a pattern across all .sx files under a directory. Returns file paths, tree paths, and summaries."
|
||||
[dir_prop; ("pattern", `Assoc [("type", `String "string"); ("description", `String "Search pattern")])] ["dir"; "pattern"];
|
||||
tool "sx_comp_list" "List all definitions (defcomp, defisland, defmacro, defpage, define) across .sx files in a directory."
|
||||
[dir_prop] ["dir"];
|
||||
tool "sx_comp_usage" "Find all uses of a component or symbol name across .sx files in a directory."
|
||||
[dir_prop; ("name", `Assoc [("type", `String "string"); ("description", `String "Component or symbol name to search for")])] ["dir"; "name"];
|
||||
tool "sx_find_across" "Search for a pattern across all .sx files under a directory. Returns file paths, tree paths, and summaries. Paginated (default 200 results)."
|
||||
[dir_prop; ("pattern", `Assoc [("type", `String "string"); ("description", `String "Search pattern")]);
|
||||
("limit", `Assoc [("type", `String "integer"); ("description", `String "Max results to return (default: 200)")]);
|
||||
("offset", `Assoc [("type", `String "integer"); ("description", `String "Skip first N results (default: 0)")])] ["dir"; "pattern"];
|
||||
tool "sx_comp_list" "List all definitions (defcomp, defisland, defmacro, defpage, define) across .sx files in a directory. Paginated (default 200 results)."
|
||||
[dir_prop;
|
||||
("limit", `Assoc [("type", `String "integer"); ("description", `String "Max results to return (default: 200)")]);
|
||||
("offset", `Assoc [("type", `String "integer"); ("description", `String "Skip first N results (default: 0)")])] ["dir"];
|
||||
tool "sx_comp_usage" "Find all uses of a component or symbol name across .sx files in a directory. Paginated (default 200 results)."
|
||||
[dir_prop; ("name", `Assoc [("type", `String "string"); ("description", `String "Component or symbol name to search for")]);
|
||||
("limit", `Assoc [("type", `String "integer"); ("description", `String "Max results to return (default: 200)")]);
|
||||
("offset", `Assoc [("type", `String "integer"); ("description", `String "Skip first N results (default: 0)")])] ["dir"; "name"];
|
||||
tool "sx_diff" "Structural diff between two .sx files. Reports ADDED, REMOVED, CHANGED nodes with paths."
|
||||
[("file_a", `Assoc [("type", `String "string"); ("description", `String "Path to first .sx file")]);
|
||||
("file_b", `Assoc [("type", `String "string"); ("description", `String "Path to second .sx file")])] ["file_a"; "file_b"];
|
||||
|
||||
Reference in New Issue
Block a user