diff --git a/bin/main.ml b/bin/main.ml index 8f8705d..040ec98 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -230,32 +230,93 @@ let cmd_manpage_dir dir = ) command_sections let help_resolve ?(timeout=10_000) cmd rest name = - let resolve_one go rest name depth = - let text = match run_cmd (cmd :: rest @ ["--help"]) timeout with - | Some _ as r -> r - | None -> run_cmd (cmd :: rest @ ["-h"]) timeout in - match text with - | None -> None - | Some text -> - (match parse_help text with - | Error _ -> None - | Ok r when r.entries = [] && r.subcommands = [] -> None - | Ok r when depth >= 5 -> Some (generate_extern name r) - | Ok r -> - let main = generate_extern name { r with subcommands = [] } in - let subs = List.map (fun (sc : subcommand) -> - let sub_name = name ^ " " ^ sc.name in - match go (rest @ [sc.name]) sub_name (depth + 1) with - | Some s -> "\n" ^ s - | None -> - Printf.sprintf "\nexport extern \"%s\" [ # %s\n]\n" - (escape_nu sub_name) (escape_nu sc.desc) - ) r.subcommands in - Some (String.concat "" (main :: subs))) - in - let fix = ref (fun _ _ _ -> None) in - fix := (fun rest name depth -> resolve_one !fix rest name depth); - !fix rest name 0 + let max_jobs = num_cores () in + let queue = Queue.create () in + Queue.push (rest, name, 0, "") queue; + let results = ref [] in + (* pending: (pid, rd, rest, name, depth, desc) *) + let pending = ref [] in + let collect rd p_rest p_name p_depth p_desc = + let ic = Unix.in_channel_of_descr rd in + let[@warning "-8"] result : (string * (string * string) list) option = + try Marshal.from_channel ic with _ -> None in + close_in ic; + match result with + | None -> + if p_desc <> "" then + results := Printf.sprintf "export extern \"%s\" [ # %s\n]\n" + (escape_nu p_name) (escape_nu p_desc) :: !results + | Some (code, subs) -> + results := code :: !results; + if p_depth < 5 then + List.iter (fun (sc_name, sc_desc) -> + Queue.push + (p_rest @ [sc_name], p_name ^ " " ^ sc_name, + p_depth + 1, sc_desc) queue + ) subs in + let reap () = + pending := List.filter (fun (pid, rd, p_rest, p_name, p_depth, p_desc) -> + match Unix.waitpid [Unix.WNOHANG] pid with + | (0, _) -> true + | _ -> collect rd p_rest p_name p_depth p_desc; false + | exception Unix.Unix_error (Unix.ECHILD, _, _) -> + collect rd p_rest p_name p_depth p_desc; false + ) !pending in + let wait_slot () = + while List.length !pending >= max_jobs do + reap (); + if List.length !pending >= max_jobs then + (try ignore (Unix.wait ()) with Unix.Unix_error _ -> ()); + reap () + done in + while not (Queue.is_empty queue) || !pending <> [] do + while not (Queue.is_empty queue) do + let (q_rest, q_name, q_depth, q_desc) = Queue.pop queue in + wait_slot (); + let (rd, wr) = Unix.pipe () in + let pid = Unix.fork () in + if pid = 0 then begin + Unix.close rd; + List.iter (fun (_, prd, _, _, _, _) -> + try Unix.close prd with _ -> ()) !pending; + let result = + let text = match run_cmd (cmd :: q_rest @ ["--help"]) timeout with + | Some _ as r -> r + | None -> run_cmd (cmd :: q_rest @ ["-h"]) timeout in + match text with + | None -> None + | Some text -> + (match parse_help text with + | Error _ -> None + | Ok r when r.entries = [] && r.subcommands = [] && r.positionals = [] -> None + | Ok r -> + let at_limit = q_depth >= 5 in + let code = generate_extern q_name + (if at_limit then r else { r with subcommands = [] }) in + let subs = if at_limit then [] + else List.map (fun (sc : subcommand) -> (sc.name, sc.desc)) + r.subcommands in + Some (code, subs)) in + let oc = Unix.out_channel_of_descr wr in + Marshal.to_channel oc (result : (string * (string * string) list) option) []; + close_out oc; + exit 0 + end else begin + Unix.close wr; + pending := (pid, rd, q_rest, q_name, q_depth, q_desc) :: !pending + end + done; + if !pending <> [] then begin + reap (); + if !pending <> [] && Queue.is_empty queue then begin + (try ignore (Unix.wait ()) with Unix.Unix_error _ -> ()); + reap () + end + end + done; + match !results with + | [] -> None + | rs -> Some (String.concat "\n" (List.rev rs)) let cmd_help args = let iterative, cmd_args = match args with diff --git a/lib/parser.ml b/lib/parser.ml index efe3087..81bf201 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -415,18 +415,21 @@ let extract_usage_positionals text = else let t = String.trim lines_arr.(i) in let tlen = String.length t in - if tlen >= 6 then - let prefix = String.lowercase_ascii (String.sub t 0 6) in - if prefix = "usage:" then begin - let after = String.sub t 6 (tlen - 6) |> String.trim in - if String.length after > 0 then Some after - else if i + 1 < len then - (* Clap style: USAGE:\n cmd [OPTIONS] PATTERN *) - let next = String.trim lines_arr.(i + 1) in - if String.length next > 0 then Some next else None - else None - end else go (i + 1) - else go (i + 1) + let lc = String.lowercase_ascii t in + if tlen >= 6 && String.sub lc 0 6 = "usage:" then begin + let after = String.sub t 6 (tlen - 6) |> String.trim in + if String.length after > 0 then Some after + else if i + 1 < len then + (* Clap style: USAGE:\n cmd [OPTIONS] PATTERN *) + let next = String.trim lines_arr.(i + 1) in + if String.length next > 0 then Some next else None + else None + end else if lc = "usage" then begin + if i + 1 < len then + let next = String.trim lines_arr.(i + 1) in + if String.length next > 0 then Some next else None + else None + end else go (i + 1) in go 0 in