diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 1b8f7492..082ad9dc 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -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 = "' 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"