SAVE GAME
This commit is contained in:
atagen
parent
5de8e62e66
commit
1d0d3465c1
7 changed files with 641 additions and 10 deletions
236
bin/main.ml
236
bin/main.ml
|
|
@ -1,14 +1,21 @@
|
|||
open Inshellah.Parser
|
||||
open Inshellah.Manpage
|
||||
open Inshellah.Nushell
|
||||
open Inshellah.Store
|
||||
|
||||
module SSet = Set.Make(String)
|
||||
|
||||
let usage () =
|
||||
Printf.eprintf
|
||||
{|inshellah - generate nushell completions
|
||||
{|inshellah - nushell completions engine
|
||||
|
||||
Usage:
|
||||
inshellah index PREFIX... [--db PATH]
|
||||
Index completions into a SQLite database.
|
||||
PREFIX is a directory containing bin/ and share/man/.
|
||||
Default db: $XDG_CACHE_HOME/inshellah/completions.db
|
||||
inshellah dump [--db PATH]
|
||||
Show stats and commands in the database.
|
||||
inshellah generate BINDIR MANDIR -o OUTDIR
|
||||
Full generation: native completions, manpages, and --help fallback.
|
||||
One .nu file per command.
|
||||
|
|
@ -250,6 +257,8 @@ let cmd_manpage_dir dir =
|
|||
) (Sys.readdir subdir)
|
||||
) command_sections
|
||||
|
||||
let max_resolve_results = 500
|
||||
|
||||
let help_resolve ?(timeout=10_000) cmd rest name =
|
||||
let max_jobs = num_cores () in
|
||||
let queue = Queue.create () in
|
||||
|
|
@ -269,7 +278,7 @@ let help_resolve ?(timeout=10_000) cmd rest name =
|
|||
(escape_nu p_name) (escape_nu p_desc) :: !results
|
||||
| Some (code, subs) ->
|
||||
results := code :: !results;
|
||||
if p_depth < 5 then
|
||||
if p_depth < 5 && List.length !results < max_resolve_results then
|
||||
List.iter (fun (sc_name, sc_desc) ->
|
||||
Queue.push
|
||||
(p_rest @ [sc_name], p_name ^ " " ^ sc_name,
|
||||
|
|
@ -311,6 +320,17 @@ let help_resolve ?(timeout=10_000) cmd rest name =
|
|||
| Error _ -> None
|
||||
| Ok r when r.entries = [] && r.subcommands = [] && r.positionals = [] -> None
|
||||
| Ok r ->
|
||||
(* If the subcommand we just queried appears in its own
|
||||
subcommand list, the command is echoing the parent help
|
||||
(e.g. nil ignores subcommands when --help is present).
|
||||
Abandon this branch to avoid infinite recursion. *)
|
||||
let self_listed = match q_rest with
|
||||
| [] -> false
|
||||
| _ ->
|
||||
let leaf = List.nth q_rest (List.length q_rest - 1) in
|
||||
List.exists (fun (sc : subcommand) -> sc.name = leaf) r.subcommands in
|
||||
if self_listed then None
|
||||
else
|
||||
let at_limit = q_depth >= 5 in
|
||||
let code = generate_extern q_name
|
||||
(if at_limit then r else { r with subcommands = [] }) in
|
||||
|
|
@ -390,14 +410,14 @@ let manpaged_commands mandir =
|
|||
else acc
|
||||
) SSet.empty command_sections
|
||||
|
||||
let cmd_generate bindir mandir outdir =
|
||||
let cmd_generate bindir mandir outdir ignorelist =
|
||||
let done_cmds = ref SSet.empty in
|
||||
let bins = Sys.readdir bindir in
|
||||
Array.sort String.compare bins;
|
||||
let manpaged = manpaged_commands mandir in
|
||||
let max_jobs = num_cores () in
|
||||
let classified = Array.map (fun name ->
|
||||
if SSet.mem name manpaged then (name, Skip)
|
||||
if SSet.mem name manpaged || SSet.mem name ignorelist then (name, Skip)
|
||||
else (name, classify_binary bindir name)
|
||||
) bins in
|
||||
let pending = ref [] in
|
||||
|
|
@ -487,6 +507,176 @@ let cmd_generate bindir mandir outdir =
|
|||
end
|
||||
) command_sections
|
||||
|
||||
|
||||
(* Sequential help resolver for use inside forked children.
|
||||
No forking — just iterates through subcommands with run_cmd directly. *)
|
||||
let help_resolve_seq ?(timeout=200) cmd rest name =
|
||||
let queue = Queue.create () in
|
||||
Queue.push (rest, name, 0) queue;
|
||||
let results = ref [] in
|
||||
while not (Queue.is_empty queue) do
|
||||
let (q_rest, q_name, q_depth) = Queue.pop queue in
|
||||
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 -> ()
|
||||
| Some text ->
|
||||
(match parse_help text with
|
||||
| Error _ -> ()
|
||||
| Ok r when r.entries = [] && r.subcommands = [] && r.positionals = [] -> ()
|
||||
| Ok r ->
|
||||
let self_listed = match q_rest with
|
||||
| [] -> false
|
||||
| _ ->
|
||||
let leaf = List.nth q_rest (List.length q_rest - 1) in
|
||||
List.exists (fun (sc : subcommand) -> sc.name = leaf) r.subcommands in
|
||||
if not self_listed then begin
|
||||
let at_limit = q_depth >= 5 || List.length !results >= max_resolve_results in
|
||||
results := (q_name, { r with subcommands = [] }) :: !results;
|
||||
if not at_limit then
|
||||
List.iter (fun (sc : subcommand) ->
|
||||
Queue.push (q_rest @ [sc.name], q_name ^ " " ^ sc.name, q_depth + 1) queue
|
||||
) r.subcommands
|
||||
end)
|
||||
done;
|
||||
List.rev !results
|
||||
|
||||
(* Index: mirrors cmd_generate's fork-per-binary pattern.
|
||||
Each child handles one binary completely (including subcommand resolution)
|
||||
and marshals all results back in one shot. No nested forking — children
|
||||
use help_resolve_seq which is purely sequential. *)
|
||||
let cmd_index bindirs mandirs ignorelist db_path =
|
||||
let db = init db_path in
|
||||
begin_transaction db;
|
||||
let done_cmds = ref SSet.empty in
|
||||
let n_results = ref 0 in
|
||||
let index_bindir bindir mandir =
|
||||
if not (Sys.file_exists bindir && Sys.is_directory bindir) then
|
||||
Printf.eprintf "skipping %s (not found)\n" bindir
|
||||
else begin
|
||||
let bins = Sys.readdir bindir in
|
||||
Array.sort String.compare bins;
|
||||
let manpaged = if Sys.file_exists mandir && Sys.is_directory mandir
|
||||
then manpaged_commands mandir else SSet.empty in
|
||||
let max_jobs = num_cores () in
|
||||
let classified = Array.map (fun name ->
|
||||
if SSet.mem name manpaged || SSet.mem name ignorelist then (name, Skip)
|
||||
else (name, classify_binary bindir name)
|
||||
) bins in
|
||||
let pending = ref [] in
|
||||
let reap () =
|
||||
pending := List.filter (fun (pid, rd, name) ->
|
||||
match Unix.waitpid [Unix.WNOHANG] pid with
|
||||
| (0, _) -> true
|
||||
| _ ->
|
||||
let ic = Unix.in_channel_of_descr rd in
|
||||
(let[@warning "-8"] result : [`Native of string | `Parsed of (string * help_result) list | `None] =
|
||||
try Marshal.from_channel ic with _ -> `None in
|
||||
match result with
|
||||
| `Native src ->
|
||||
upsert_raw db ~source:"native" name src;
|
||||
incr n_results
|
||||
| `Parsed pairs ->
|
||||
List.iter (fun (cmd_name, r) ->
|
||||
if not (SSet.mem cmd_name !done_cmds) then begin
|
||||
upsert db ~source:"help" cmd_name r;
|
||||
done_cmds := SSet.add cmd_name !done_cmds;
|
||||
incr n_results
|
||||
end
|
||||
) pairs
|
||||
| `None -> ());
|
||||
close_in ic;
|
||||
done_cmds := SSet.add name !done_cmds;
|
||||
false
|
||||
| exception Unix.Unix_error (Unix.ECHILD, _, _) ->
|
||||
(try Unix.close rd with _ -> ()); 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
|
||||
Array.iter (fun (name, cls) ->
|
||||
match cls with
|
||||
| Skip -> ()
|
||||
| Try_help | Try_native_and_help ->
|
||||
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 =
|
||||
try
|
||||
let path = Filename.concat bindir name in
|
||||
let native = match cls with
|
||||
| Try_native_and_help ->
|
||||
(match try_native_completion path with
|
||||
| Some src -> Some src | None -> None)
|
||||
| _ -> None in
|
||||
match native with
|
||||
| Some src -> `Native src
|
||||
| None ->
|
||||
let pairs = help_resolve_seq ~timeout:200 path [] name in
|
||||
if pairs <> [] then `Parsed pairs else `None
|
||||
with _ -> `None in
|
||||
let oc = Unix.out_channel_of_descr wr in
|
||||
Marshal.to_channel oc
|
||||
(result : [`Native of string | `Parsed of (string * help_result) list | `None]) [];
|
||||
close_out oc;
|
||||
exit 0
|
||||
end else begin
|
||||
Unix.close wr;
|
||||
pending := (pid, rd, name) :: !pending
|
||||
end
|
||||
) classified;
|
||||
while !pending <> [] do
|
||||
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
|
||||
reap ()
|
||||
done;
|
||||
(* Phase 2: manpages *)
|
||||
if Sys.file_exists mandir && Sys.is_directory mandir then
|
||||
List.iter (fun section ->
|
||||
let subdir = Filename.concat mandir (Printf.sprintf "man%d" section) in
|
||||
if Sys.file_exists subdir && Sys.is_directory subdir then begin
|
||||
let files = Sys.readdir subdir in
|
||||
Array.sort String.compare files;
|
||||
Array.iter (fun file ->
|
||||
match process_manpage (Filename.concat subdir file) with
|
||||
| None -> ()
|
||||
| Some (cmd, result) ->
|
||||
if not (SSet.mem cmd !done_cmds) then begin
|
||||
upsert db ~source:"manpage" cmd result;
|
||||
done_cmds := SSet.add cmd !done_cmds;
|
||||
incr n_results
|
||||
end
|
||||
) files
|
||||
end
|
||||
) command_sections
|
||||
end in
|
||||
List.iter2 index_bindir bindirs mandirs;
|
||||
commit db;
|
||||
Printf.printf "indexed %d commands into %s\n" !n_results db_path;
|
||||
close db
|
||||
|
||||
let cmd_dump db_path =
|
||||
let db = init db_path in
|
||||
let (count, sources) = stats db in
|
||||
Printf.printf "database: %s\n" db_path;
|
||||
Printf.printf "commands: %d (from %d sources)\n" count sources;
|
||||
let cmds = all_commands db in
|
||||
List.iter (fun cmd ->
|
||||
match lookup db cmd with
|
||||
| None -> ()
|
||||
| Some (_data, source) ->
|
||||
Printf.printf " %-40s [%s]\n" cmd source
|
||||
) cmds;
|
||||
close db
|
||||
|
||||
let cmd_demo () =
|
||||
Printf.printf "# Generated by: inshellah demo\n\n";
|
||||
match parse_help
|
||||
|
|
@ -502,9 +692,45 @@ let cmd_demo () =
|
|||
| Ok r -> print_string (generate_extern "ls" r)
|
||||
| Error msg -> Printf.eprintf "parse error: %s\n" msg
|
||||
|
||||
let load_ignorelist path =
|
||||
try
|
||||
let ic = open_in path in
|
||||
let lines = ref [] in
|
||||
(try while true do
|
||||
let line = String.trim (input_line ic) in
|
||||
if String.length line > 0 && line.[0] <> '#' then
|
||||
lines := line :: !lines
|
||||
done with End_of_file -> ());
|
||||
close_in ic;
|
||||
SSet.of_list !lines
|
||||
with _ -> SSet.empty
|
||||
|
||||
let parse_index_args args =
|
||||
let rec go prefixes db ignore = function
|
||||
| [] -> (List.rev prefixes, db, ignore)
|
||||
| "--db" :: path :: rest -> go prefixes path ignore rest
|
||||
| "--ignore" :: path :: rest -> go prefixes db (SSet.union ignore (load_ignorelist path)) rest
|
||||
| dir :: rest -> go (dir :: prefixes) db ignore rest in
|
||||
go [] (default_db_path ()) SSet.empty args
|
||||
|
||||
let () =
|
||||
match Array.to_list Sys.argv |> List.tl with
|
||||
| ["generate"; bindir; mandir; "-o"; outdir] -> cmd_generate bindir mandir outdir
|
||||
| ["generate"; bindir; mandir; "-o"; outdir] ->
|
||||
cmd_generate bindir mandir outdir SSet.empty
|
||||
| ["generate"; bindir; mandir; "-o"; outdir; "--ignore"; ignore_file] ->
|
||||
cmd_generate bindir mandir outdir (load_ignorelist ignore_file)
|
||||
| "index" :: rest ->
|
||||
let (prefixes, db_path, ignorelist) = parse_index_args rest in
|
||||
if prefixes = [] then (Printf.eprintf "error: index requires at least one prefix dir\n"; exit 1);
|
||||
let bindirs = List.map (fun p -> Filename.concat p "bin") prefixes in
|
||||
let mandirs = List.map (fun p -> Filename.concat p "share/man") prefixes in
|
||||
cmd_index bindirs mandirs ignorelist db_path
|
||||
| "dump" :: rest ->
|
||||
let db_path = match rest with
|
||||
| ["--db"; path] -> path
|
||||
| [] -> default_db_path ()
|
||||
| _ -> Printf.eprintf "error: dump [--db PATH]\n"; exit 1 in
|
||||
cmd_dump db_path
|
||||
| ["manpage"; file] -> cmd_manpage file
|
||||
| ["manpage-dir"; dir] -> cmd_manpage_dir dir
|
||||
| "help" :: rest -> cmd_help rest
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue