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

Proper handler dispatch: nested slugs, method lookup, param binding

Browse Source 
Rewrites the OCaml handler dispatch to handle all handler types:

1. Nested slug extraction: (api.(editrow.1)) → slug "editrow", param "1"
2. Method-based handler lookup: tries exact slug, then suffixes like
   -form (GET), -save/-submit (POST), -put (PUT)
3. Path param injection: extracts <sx:param_name> from handler path
   template, converts underscores to hyphens, injects into query string
4. Param binding: reads handler (&key) params via request-arg/request-form
   and binds them in env before aser evaluation
5. Handles both List and ListRef param storage (CEK may mutate)
6. Response status support: set-response-status handled natively

Fixes: delete-row, edit-row, tabs, editrow-cancel, and all parameterized
handlers. 17/19 handlers now return 200 (flaky=503 intentional, slow=500
IO bridge timeout).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-01 21:52:59 +00:00
parent f66195ce18
commit 0019f8e56a
1 changed files with 69 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
hosts/ocaml/bin/sx_server.ml
View File

@@ -640,12 +640,15 @@ let setup_strict_mode env =
bind "component-set-file!" (fun args -> match args with [v; f] -> component_set_file v f | _ -> Nil)
(* ---- IO helpers routed to Python bridge ---- *)
let _pending_response_status = ref 200
let setup_io_bridges env =
let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
bind "json-encode" (fun args -> io_request "helper" (String "json-encode" :: args));
bind "into" (fun args -> io_request "helper" (String "into" :: args));
bind "sleep" (fun args -> io_request "sleep" args);
bind "set-response-status" (fun args -> io_request "set-response-status" args);
bind "set-response-status" (fun args -> match args with
| [Number n] -> _pending_response_status := int_of_float n; Nil
| _ -> Nil);
bind "set-response-header" (fun args -> io_request "set-response-header" args)
(* ---- HTML tag functions (div, span, h1, ...) ---- *)
@@ -2650,52 +2653,81 @@ let http_mode port =
let is_sx = path = "/sx/" || path = "/sx"
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in
if is_sx && is_handler_path then begin
(* Handler dispatch — look up handler dict, evaluate body, aser result *)
(* Handler dispatch — slug + path param extraction, method-based lookup, param binding *)
let response =
try
let slug =
let slug, path_param_val =
let rec find_api s i =
if i + 5 > String.length s then ""
else if String.sub s i 5 = "(api." then
if i + 5 > String.length s then ("", None)
else if String.sub s i 5 = "(api." then begin
let start = i + 5 in
if start < String.length s && s.[start] = '(' then
(* Nested: (api.(delete.1)) — extract "delete" as slug,
inject path param into query string *)
if start < String.length s && s.[start] = '(' then begin
let inner = start + 1 in
let end_ =
let rec scan j =
if j >= String.length s then j
else match s.[j] with '.' | ')' -> j | _ -> scan (j + 1)
in scan inner in
let handler_name = String.sub s inner (end_ - inner) in
(* Extract path param value if present (after the dot) *)
if end_ < String.length s && s.[end_] = '.' then begin
let val_start = end_ + 1 in
let val_end = try String.index_from s val_start ')' with Not_found -> String.length s in
let param_val = String.sub s val_start (val_end - val_start) in
(* Append to query string so request-arg can find it *)
let sep = if !_req_query = "" then "" else "&" in
_req_query := !_req_query ^ sep ^ "item-id=" ^ param_val
end;
handler_name
else
let end_ = let rec sc j = if j >= String.length s then j
else match s.[j] with '.' | ')' -> j | _ -> sc (j+1) in sc inner in
let name = String.sub s inner (end_ - inner) in
let pval = if end_ < String.length s && s.[end_] = '.' then
let vs = end_ + 1 in
let ve = try String.index_from s vs ')' with Not_found -> String.length s in
Some (String.sub s vs (ve - vs)) else None in
(name, pval)
end else begin
let end_ = try String.index_from s start ')' with Not_found -> String.length s in
String.sub s start (end_ - start)
else find_api s (i + 1) in
(String.sub s start (end_ - start), None)
end
end else find_api s (i + 1) in
find_api path 0 in
let handler_key = "handler:ex-" ^ slug in
let hdef = try env_get env handler_key with _ -> Nil in
if hdef = Nil then
let req_method = String.uppercase_ascii !_req_method in
let try_key k = try let v = env_get env k in
if v <> Nil then Some (k, v) else None with _ -> None in
let base = "handler:ex-" ^ slug in
let suffixes = match req_method with
| "POST" -> [base; base ^ "-save"; base ^ "-submit"]
| "PUT" | "PATCH" -> [base; base ^ "-put"; base ^ "-save"]
| "DELETE" -> [base]
| _ -> [base; base ^ "-form"; base ^ "-status"] in
let found = List.fold_left (fun acc k ->
match acc with Some _ -> acc | None -> try_key k) None suffixes in
(match found with
| None ->
http_response ~status:404 ~content_type:"text/sx; charset=utf-8"
(Printf.sprintf "(div :class \"p-4 text-rose-600\" \"Handler not found: %s\")" handler_key)
else
let body = match hdef with Dict d -> (match Hashtbl.find_opt d "body" with Some v -> v | None -> Nil) | _ -> Nil in
(* Evaluate the body in the global env — aser renders HTML tags to wire format *)
(Printf.sprintf "(div :class \"p-4 text-rose-600\" \"Handler not found: %s\")" base)
| Some (_hk, hdef) ->
(match path_param_val with
| Some pval ->
let ppath = (match hdef with Dict d ->
(match Hashtbl.find_opt d "path" with Some (String s) -> s | _ -> "") | _ -> "") in
let pname = let rec f s i = if i + 4 > String.length s then "id"
else if String.sub s i 4 = "<sx:" then
let gt = try String.index_from s (i+4) '>' with Not_found -> String.length s in
String.map (fun c -> if c = '_' then '-' else c) (String.sub s (i+4) (gt-i-4))
else f s (i+1) in f ppath 0 in
let sep = if !_req_query = "" then "" else "&" in
_req_query := !_req_query ^ sep ^ pname ^ "=" ^ pval
| None -> ());
let body = (match hdef with Dict d ->
(match Hashtbl.find_opt d "body" with Some v -> v | None -> Nil) | _ -> Nil) in
let params = (match hdef with Dict d ->
(match Hashtbl.find_opt d "params" with
| Some (List p) -> p | Some (ListRef r) -> !r | _ -> []) | _ -> []) in
let param_names = List.filter_map (fun p -> match p with
| Symbol s when s <> "&key" && s <> "&rest" -> Some s
| String s when s <> "&key" && s <> "&rest" -> Some s
| _ -> None) params in
(* Bind handler params in env before aser *)
List.iter (fun n ->
let v = try Sx_ref.eval_expr
(List [Symbol "or"; List [Symbol "request-arg"; String n];
List [Symbol "request-form"; String n]]) (Env env)
with _ -> Nil in
ignore (env_bind env n v)
) param_names;
_pending_response_status := 200;
let aser_call = List [Symbol "aser"; List [Symbol "quote"; body]; Env env] in
let body_str = match Sx_ref.eval_expr aser_call (Env env) with
| String s | SxExpr s -> s
| v -> Sx_types.inspect v in
http_response ~content_type:"text/sx; charset=utf-8" body_str
| String s | SxExpr s -> s | v -> Sx_types.inspect v in
let status = !_pending_response_status in
http_response ~status ~content_type:"text/sx; charset=utf-8" body_str)
with e ->
Printf.eprintf "[handler] Error for %s: %s\n%!" path (Printexc.to_string e);
http_response ~status:500 ~content_type:"text/sx; charset=utf-8"