From 144d72b22308f84ae59b7794c0bc42c7311b0968 Mon Sep 17 00:00:00 2001 From: atagen Date: Mon, 23 Mar 2026 16:24:00 +1100 Subject: [PATCH] refactor --- bin/main.ml | 197 +++++++++++++++++++++++-------------------------- dune-project | 4 +- lib/manpage.ml | 41 +++++----- lib/parser.ml | 30 -------- lib/store.ml | 174 +++++++++++++++++++------------------------ 5 files changed, 188 insertions(+), 258 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index dd66912..4ef15c7 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -233,7 +233,11 @@ let num_cores () = with _ -> 4 let try_native_completion bin_path = - let patterns = [ + List.find_map (fun args -> + match run_cmd args 500 with + | Some text when is_nushell_source text -> Some text + | _ -> None + ) [ [bin_path; "completions"; "nushell"]; [bin_path; "completion"; "nushell"]; [bin_path; "--completions"; "nushell"]; @@ -241,30 +245,35 @@ let try_native_completion bin_path = [bin_path; "generate-completion"; "nushell"]; [bin_path; "--generate-completion"; "nushell"]; [bin_path; "shell-completions"; "nushell"]; - ] in - let rec go = function - | [] -> None - | args :: rest -> - match run_cmd args 500 with - | Some text when is_nushell_source text -> Some text - | _ -> go rest - in - go patterns + ] -let cmd_manpage file = +let parse_manpage_for_command file = let contents = read_manpage_file file in let fallback = cmd_name_of_manpage file in let cmd = match extract_synopsis_command contents with | Some name -> name | None -> fallback in - if not (is_nushell_builtin cmd) then + if is_nushell_builtin cmd then None + else let result = parse_manpage_string contents in - if result.entries <> [] then - print_string (generate_extern cmd result) + let sub_sections = extract_subcommand_sections contents in + let result = if sub_sections <> [] then + { result with subcommands = List.map (fun (name, desc, _) -> + { name; desc }) sub_sections } + else result in + let subs = List.map (fun (name, _desc, r) -> + (cmd ^ " " ^ name, r)) sub_sections in + Some (cmd, result, subs) + +let cmd_manpage file = + match parse_manpage_for_command file with + | Some (cmd, result, _) when result.entries <> [] -> + print_string (generate_extern cmd result) + | _ -> () let cmd_manpage_dir dir = List.iter (fun section -> let subdir = Filename.concat dir (Printf.sprintf "man%d" section) in - if Sys.file_exists subdir && Sys.is_directory subdir then + if is_dir subdir then Array.iter (fun file -> (try cmd_manpage (Filename.concat subdir file) with _ -> ()) ) (Sys.readdir subdir) @@ -274,28 +283,16 @@ let max_resolve_results = 500 let process_manpage file = try - let contents = read_manpage_file file in - let fallback = cmd_name_of_manpage file in - let cmd = match extract_synopsis_command contents with - | Some name -> name | None -> fallback in - if is_nushell_builtin cmd then None - else - let result = parse_manpage_string contents in - let sub_sections = extract_subcommand_sections contents in - let result = if sub_sections <> [] then - { result with subcommands = List.map (fun (name, desc, _) -> - { name; desc }) sub_sections } - else result in - let subs = List.map (fun (name, _desc, r) -> - (cmd ^ " " ^ name, r)) sub_sections in - if result.entries <> [] || subs <> [] then Some (cmd, result, subs) - else None + match parse_manpage_for_command file with + | Some (cmd, result, subs) when result.entries <> [] || subs <> [] -> + Some (cmd, result, subs) + | _ -> None with _ -> None let manpaged_commands mandir = List.fold_left (fun acc section -> let subdir = Filename.concat mandir (Printf.sprintf "man%d" section) in - if Sys.file_exists subdir && Sys.is_directory subdir then + if is_dir subdir then Array.fold_left (fun acc f -> SSet.add (cmd_name_of_manpage f) acc) acc (Sys.readdir subdir) else acc @@ -403,12 +400,12 @@ let cmd_index bindirs mandirs ignorelist help_only dir = 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 + if not (is_dir 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 + let manpaged = if is_dir mandir then manpaged_commands mandir else SSet.empty in let max_jobs = num_cores () in let classified = Array.map (fun name -> @@ -502,10 +499,10 @@ let cmd_index bindirs mandirs ignorelist help_only dir = end done; (* Phase 2: manpages *) - if Sys.file_exists mandir && Sys.is_directory mandir then + if is_dir 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 + if is_dir subdir then begin let files = Sys.readdir subdir in Array.sort String.compare files; Array.iter (fun file -> @@ -544,14 +541,11 @@ let cmd_dump dirs = let find_in_path name = try - let path_var = Sys.getenv "PATH" in - let dirs = String.split_on_char ':' path_var in - let rec go = function - | [] -> None - | dir :: rest -> - let p = Filename.concat dir name in - if is_executable p then Some p else go rest in - go dirs + Sys.getenv "PATH" + |> String.split_on_char ':' + |> List.find_map (fun dir -> + let p = Filename.concat dir name in + if is_executable p then Some p else None) with Not_found -> None let resolve_and_cache ~dir name path = @@ -567,50 +561,47 @@ let completion_json value desc = (escape_json value) (escape_json desc) let flag_completions prefix entries = - let candidates = ref [] in - List.iter (fun (e : entry) -> + List.filter_map (fun (e : entry) -> let desc = match e.param with | Some (Mandatory p) -> if e.desc <> "" then e.desc ^ " <" ^ p ^ ">" else "<" ^ p ^ ">" | Some (Optional p) -> if e.desc <> "" then e.desc ^ " [" ^ p ^ "]" else "[" ^ p ^ "]" | None -> e.desc in - (match e.switch with - | Long l -> - let flag = "--" ^ l in - if String.starts_with ~prefix flag then - candidates := completion_json flag desc :: !candidates - | Short c -> - let flag = Printf.sprintf "-%c" c in - if String.starts_with ~prefix flag then - candidates := completion_json flag desc :: !candidates - | Both (c, l) -> - let long = "--" ^ l in - let short = Printf.sprintf "-%c" c in - if String.starts_with ~prefix long then - candidates := completion_json long desc :: !candidates - else if String.starts_with ~prefix short then - candidates := completion_json short desc :: !candidates) - ) entries; - List.rev !candidates + match e.switch with + | Long l -> + let flag = "--" ^ l in + if String.starts_with ~prefix flag then Some (completion_json flag desc) else None + | Short c -> + let flag = Printf.sprintf "-%c" c in + if String.starts_with ~prefix flag then Some (completion_json flag desc) else None + | Both (c, l) -> + let long = "--" ^ l in + let short = Printf.sprintf "-%c" c in + if String.starts_with ~prefix long then Some (completion_json long desc) + else if String.starts_with ~prefix short then Some (completion_json short desc) + else None + ) entries let cmd_complete spans user_dir system_dirs = match spans with | [] -> print_string "[]\n" | cmd_name :: rest -> let dirs = user_dir :: system_dirs in - (* Try longest subcommand match first: "git add" before "git" *) - let rec find_result tokens = - match tokens with - | [] -> None - | _ -> - let try_name = String.concat " " tokens in - match lookup dirs try_name with - | Some r -> Some (try_name, r, List.length tokens) - | None -> - find_result (List.rev (List.tl (List.rev tokens))) in + (* Try longest prefix match: "git add" before "git" *) + let find_result tokens = + let n = List.length tokens in + List.init n Fun.id |> List.find_map (fun drop -> + let prefix = List.filteri (fun i _ -> i < n - drop) tokens in + match prefix with + | [] -> None + | _ -> + let try_name = String.concat " " prefix in + match lookup dirs try_name with + | Some r -> Some (try_name, r, List.length prefix) + | None -> None) in let all_tokens = cmd_name :: rest in - let partial_tokens = cmd_name :: (match rest with - | _ :: _ -> List.rev (List.tl (List.rev rest)) - | _ -> []) in + let partial_tokens = match rest with + | _ :: _ -> cmd_name :: List.rev (List.tl (List.rev rest)) + | _ -> [cmd_name] in let last_token = match rest with | [] -> "" | _ -> List.nth rest (List.length rest - 1) in (* Try full token list first (last token is a complete subcommand), @@ -630,25 +621,24 @@ let cmd_complete spans user_dir system_dirs = | Some _pairs -> try_both () | None -> (None, partial)) | None -> (None, partial)) in - (match result with - | None -> print_string "[]\n" - | Some (_matched_name, r, _depth) -> - let candidates = ref [] in - if String.starts_with ~prefix:"-" partial then - candidates := flag_completions partial r.entries - else begin - let subs = match r.subcommands with - | _ :: _ -> r.subcommands - | [] -> subcommands_of dirs _matched_name in - List.iter (fun (sc : subcommand) -> - if partial = "" || String.starts_with ~prefix:partial sc.name then - candidates := completion_json sc.name sc.desc :: !candidates - ) subs; - candidates := List.rev !candidates; - if partial = "" || !candidates = [] then - candidates := !candidates @ flag_completions partial r.entries - end; - Printf.printf "[%s]\n" (String.concat "," !candidates)) + let candidates = match result with + | None -> [] + | Some (_matched_name, r, _depth) -> + if String.starts_with ~prefix:"-" partial then + flag_completions partial r.entries + else + let subs = match r.subcommands with + | _ :: _ -> r.subcommands + | [] -> subcommands_of dirs _matched_name in + let sub_candidates = List.filter_map (fun (sc : subcommand) -> + if partial = "" || String.starts_with ~prefix:partial sc.name then + Some (completion_json sc.name sc.desc) + else None + ) subs in + if partial = "" || sub_candidates = [] then + sub_candidates @ flag_completions partial r.entries + else sub_candidates in + Printf.printf "[%s]\n" (String.concat "," candidates) let cmd_query cmd dirs = match lookup_raw dirs cmd with @@ -659,15 +649,12 @@ let cmd_query cmd dirs = 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 + In_channel.with_open_text path In_channel.input_all + |> String.split_on_char '\n' + |> List.filter_map (fun line -> + let line = String.trim line in + if String.length line > 0 && line.[0] <> '#' then Some line else None) + |> SSet.of_list with _ -> SSet.empty let parse_index_args args = diff --git a/dune-project b/dune-project index 89cddbb..4d29412 100644 --- a/dune-project +++ b/dune-project @@ -23,8 +23,6 @@ dune angstrom angstrom-unix - camlzip - sqlite3 - (ppx_inline_test :with-test)) + camlzip) (tags (shell completions nushell parser angstrom))) diff --git a/lib/manpage.ml b/lib/manpage.ml index 436ca21..606d005 100644 --- a/lib/manpage.ml +++ b/lib/manpage.ml @@ -746,32 +746,31 @@ let extract_subcommand_sections contents = let sections = collect_sections [] None [] classified in (* For each SUBCOMMAND section, extract name from Usage: line and parse entries *) let usage_re = Str.regexp {|Usage: \([a-zA-Z0-9_-]+\)|} in + let matches_usage s = + try ignore (Str.search_forward usage_re s 0); Some (Str.matched_group 1 s) + with Not_found -> None in List.filter_map (fun (_header, section_lines) -> - (* Find subcommand name from Usage: line *) - let name = ref None in - let desc_lines = ref [] in - List.iter (fun line -> - if !name = None then - match line with - | Text s -> - if try ignore (Str.search_forward usage_re s 0); true - with Not_found -> false - then name := Some (Str.matched_group 1 s) - else desc_lines := s :: !desc_lines - | Macro (("TP" | "B" | "BI" | "BR"), args) -> - let s = strip_inline_macro_args args |> strip_groff_escapes |> String.trim in - if try ignore (Str.search_forward usage_re s 0); true - with Not_found -> false - then name := Some (Str.matched_group 1 s) - | _ -> () - ) section_lines; - match !name with + let name, desc_lines = + List.fold_left (fun (name, desc_lines) line -> + match name with + | Some _ -> (name, desc_lines) + | None -> + match line with + | Text s -> + (match matches_usage s with + | Some _ as found -> (found, desc_lines) + | None -> (None, s :: desc_lines)) + | Macro (("TP" | "B" | "BI" | "BR"), args) -> + let s = strip_inline_macro_args args |> strip_groff_escapes |> String.trim in + (matches_usage s, desc_lines) + | _ -> (None, desc_lines) + ) (None, []) section_lines in + match name with | None -> None | Some subcmd_name -> let entries = extract_entries section_lines in - let desc = String.concat " " (List.rev !desc_lines) + let desc = String.concat " " (List.rev desc_lines) |> strip_groff_escapes |> String.trim in - (* Remove backtick quoting common in clap output *) let desc = Str.global_replace (Str.regexp "`\\([^`]*\\)`") "\\1" desc in Some (subcmd_name, desc, { entries; subcommands = []; positionals = []; description = desc }) ) sections diff --git a/lib/parser.ml b/lib/parser.ml index a28e8b6..fa65da0 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -538,33 +538,3 @@ let parse_help txt = let positionals = if cli11 <> [] then cli11 else usage in Ok { result with positionals } | Error msg -> Error msg - -(* --- Pretty printers --- *) - -let print_switch = function - | Short o -> Printf.sprintf "Short: %c" o - | Long o -> Printf.sprintf "Long: %s" o - | Both (s, l) -> Printf.sprintf "Both, short: %c long: %s" s l - -let print_opt = function - | Some (Mandatory o) -> Printf.sprintf "Mandatory: %s" o - | Some (Optional o) -> Printf.sprintf "Optional: %s" o - | None -> "None" - -let print_entry e = - Printf.printf - "\n\t** ENTRY **\n\tSwitch: %s\n\tParam: %s\n\tDescription: %s\n" - (print_switch e.switch) (print_opt e.param) e.desc - -let print_subcommand sc = - Printf.printf "\n\t** SUBCOMMAND **\n\tName: %s\n\tDescription: %s\n" - sc.name sc.desc - -let print_positional p = - Printf.printf "\n\t** POSITIONAL **\n\tName: %s\n\tOptional: %b\n\tVariadic: %b\n" - p.pos_name p.optional p.variadic - -let print_help_result r = - List.iter print_entry r.entries; - List.iter print_subcommand r.subcommands; - List.iter print_positional r.positionals diff --git a/lib/store.ml b/lib/store.ml index 298044f..d8dff24 100644 --- a/lib/store.ml +++ b/lib/store.ml @@ -266,125 +266,101 @@ let write_native ~dir command data = let path = Filename.concat dir (filename_of_command command ^ ".nu") in write_file path data +let is_dir path = Sys.file_exists path && Sys.is_directory path + let find_file dirs command = let base = filename_of_command command in - let rec go = function - | [] -> None - | dir :: rest -> - let json_path = Filename.concat dir (base ^ ".json") in - if Sys.file_exists json_path then Some json_path - else - let nu_path = Filename.concat dir (base ^ ".nu") in - if Sys.file_exists nu_path then Some nu_path - else go rest in - go dirs + List.find_map (fun dir -> + let json_path = Filename.concat dir (base ^ ".json") in + if Sys.file_exists json_path then Some json_path + else + let nu_path = Filename.concat dir (base ^ ".nu") in + if Sys.file_exists nu_path then Some nu_path + else None + ) dirs let lookup dirs command = let base = filename_of_command command in - let rec go = function - | [] -> None - | dir :: rest -> - let path = Filename.concat dir (base ^ ".json") in - (match read_file path with - | Some data -> - (try Some (help_result_of_json (parse_json data)) - with _ -> None) - | None -> go rest) in - go dirs + List.find_map (fun dir -> + let path = Filename.concat dir (base ^ ".json") in + match read_file path with + | Some data -> + (try Some (help_result_of_json (parse_json data)) + with _ -> None) + | None -> None + ) dirs let lookup_raw dirs command = let base = filename_of_command command in - let rec go = function - | [] -> None - | dir :: rest -> - let json_path = Filename.concat dir (base ^ ".json") in - (match read_file json_path with - | Some _ as r -> r - | None -> - let nu_path = Filename.concat dir (base ^ ".nu") in - match read_file nu_path with - | Some _ as r -> r - | None -> go rest) in - go dirs + List.find_map (fun dir -> + let json_path = Filename.concat dir (base ^ ".json") in + match read_file json_path with + | Some _ as r -> r + | None -> + let nu_path = Filename.concat dir (base ^ ".nu") in + read_file nu_path + ) dirs -let has_command dirs command = - find_file dirs command <> None +let chop_extension f = + if Filename.check_suffix f ".json" then Some (Filename.chop_suffix f ".json") + else if Filename.check_suffix f ".nu" then Some (Filename.chop_suffix f ".nu") + else None let subcommands_of dirs command = let prefix = filename_of_command command ^ "_" in let plen = String.length prefix in let module SMap = Map.Make(String) in - let subs = ref SMap.empty in - List.iter (fun dir -> - if Sys.file_exists dir && Sys.is_directory dir then - Array.iter (fun f -> - if String.starts_with ~prefix f then + let subs = List.fold_left (fun subs dir -> + if is_dir dir then + Array.fold_left (fun subs f -> + if not (String.starts_with ~prefix f) then subs + else let is_json = Filename.check_suffix f ".json" in - let base = - if is_json then Some (Filename.chop_suffix f ".json") - else if Filename.check_suffix f ".nu" then - Some (Filename.chop_suffix f ".nu") - else None in - match base with + match chop_extension f with + | None -> subs | Some b -> let rest = String.sub b plen (String.length b - plen) in - (* Only direct children: no further underscores *) - if not (String.contains rest '_') && String.length rest > 0 then - let name = rest in - if not (SMap.mem name !subs) then - let desc = if is_json then - match read_file (Filename.concat dir f) with - | Some data -> - (try json_to_string (json_get "description" (parse_json data)) - with _ -> "") - | None -> "" - else "" in - subs := SMap.add name { name; desc } !subs - | None -> () - ) (Sys.readdir dir) - ) dirs; - SMap.fold (fun _ sc acc -> sc :: acc) !subs [] |> List.rev + if String.contains rest '_' || String.length rest = 0 then subs + else if SMap.mem rest subs then subs + else + let desc = if is_json then + match read_file (Filename.concat dir f) with + | Some data -> + (try json_to_string (json_get "description" (parse_json data)) + with _ -> "") + | None -> "" + else "" in + SMap.add rest { name = rest; desc } subs + ) subs (Sys.readdir dir) + else subs + ) SMap.empty dirs in + SMap.fold (fun _ sc acc -> sc :: acc) subs [] |> List.rev let all_commands dirs = let module SSet = Set.Make(String) in - let cmds = ref SSet.empty in - List.iter (fun dir -> - if Sys.file_exists dir && Sys.is_directory dir then - Array.iter (fun f -> - let base = - if Filename.check_suffix f ".json" then - Some (Filename.chop_suffix f ".json") - else if Filename.check_suffix f ".nu" then - Some (Filename.chop_suffix f ".nu") - else None in - match base with - | Some b -> cmds := SSet.add (command_of_filename b) !cmds - | None -> () - ) (Sys.readdir dir) - ) dirs; - SSet.elements !cmds - -let delete ~dir command = - let base = filename_of_command command in - let json_path = Filename.concat dir (base ^ ".json") in - let nu_path = Filename.concat dir (base ^ ".nu") in - (try Sys.remove json_path with Sys_error _ -> ()); - (try Sys.remove nu_path with Sys_error _ -> ()) + List.fold_left (fun cmds dir -> + if is_dir dir then + Array.fold_left (fun cmds f -> + match chop_extension f with + | Some b -> SSet.add (command_of_filename b) cmds + | None -> cmds + ) cmds (Sys.readdir dir) + else cmds + ) SSet.empty dirs + |> SSet.elements let file_type_of dirs command = let base = filename_of_command command in - let rec go = function - | [] -> None - | dir :: rest -> - let json_path = Filename.concat dir (base ^ ".json") in - if Sys.file_exists json_path then - (match read_file json_path with - | Some data -> - (try Some (json_to_string (json_get "source" (parse_json data))) - with _ -> Some "json") - | None -> Some "json") - else - let nu_path = Filename.concat dir (base ^ ".nu") in - if Sys.file_exists nu_path then Some "native" - else go rest in - go dirs + List.find_map (fun dir -> + let json_path = Filename.concat dir (base ^ ".json") in + if Sys.file_exists json_path then + (match read_file json_path with + | Some data -> + (try Some (json_to_string (json_get "source" (parse_json data))) + with _ -> Some "json") + | None -> Some "json") + else + let nu_path = Filename.concat dir (base ^ ".nu") in + if Sys.file_exists nu_path then Some "native" + else None + ) dirs