open Inshellah.Parser
open Inshellah.Manpage
open Inshellah.Nushell
open Inshellah.Store

module SSet = Set.Make(String)

let usage () =
  Printf.eprintf
    {|inshellah - nushell completions engine

Usage:
  inshellah index PREFIX... [--dir PATH] [--ignore FILE] [--help-only FILE]
      Index completions into a directory of JSON/nu files.
      PREFIX is a directory containing bin/ and share/man/.
      Default dir: $XDG_CACHE_HOME/inshellah
      --ignore FILE     skip listed commands entirely
      --help-only FILE  skip manpages for listed commands, use --help instead
  inshellah complete CMD [ARGS...] [--dir PATH] [--system-dir PATH]
      Nushell custom completer. Outputs JSON completion candidates.
      Falls back to --help resolution if command is not indexed.
  inshellah query CMD [--dir PATH] [--system-dir PATH]
      Print stored completion data for CMD.
  inshellah dump [--dir PATH] [--system-dir PATH]
      List indexed commands.
  inshellah manpage FILE            Parse a manpage and emit nushell extern
  inshellah manpage-dir DIR         Batch-process manpages under DIR

|};
  exit 1

let command_sections = [1; 8]

let contains_str s sub =
  try ignore (Str.search_forward (Str.regexp_string sub) s 0); true
  with Not_found -> false

let is_nushell_source text =
  String.length text > 20
  && (contains_str text "export extern"
      || contains_str text "export def"
      || (contains_str text "module " && contains_str text "export"))

let cmd_name_of_manpage path =
  let base = Filename.basename path in
  let base =
    if Filename.check_suffix base ".gz" then Filename.chop_suffix base ".gz"
    else base in
  try Filename.chop_extension base with Invalid_argument _ -> base

let safe_env = lazy (
  Array.of_list (
    List.filter (fun s ->
      not (String.starts_with ~prefix:"DISPLAY=" s
           || String.starts_with ~prefix:"WAYLAND_DISPLAY=" s
           || String.starts_with ~prefix:"DBUS_SESSION_BUS_ADDRESS=" s
           || String.starts_with ~prefix:"XAUTHORITY=" s))
      (Array.to_list (Unix.environment ()))))

(* Non-blocking drain of a pipe fd into a buffer.  Safe to call repeatedly;
   reads whatever is available without blocking.  Used by all fork-pipe sites
   to keep pipes drained so children never block on write. *)
let drain_fd rd buf =
  let chunk = Bytes.create 8192 in
  let continue = ref true in
  while !continue do
    match Unix.select [rd] [] [] 0.0 with
    | (_ :: _, _, _) ->
      (try
         let n = Unix.read rd chunk 0 8192 in
         if n = 0 then continue := false
         else Buffer.add_subbytes buf chunk 0 n
       with Unix.Unix_error _ -> continue := false)
    | _ -> continue := false
  done

let run_cmd args timeout_ms =
  let (rd, wr) = Unix.pipe () in
  let devnull = Unix.openfile "/dev/null" [Unix.O_RDONLY] 0 in
  let argv = Array.of_list args in
  (* Run subprocesses in /tmp so commands that write side-effect files
     (e.g. ckb-next-dev-detect-report.gz) don't pollute the working dir *)
  let saved_cwd = Sys.getcwd () in
  Sys.chdir "/tmp";
  let pid =
    try Unix.create_process_env (List.hd args) argv
          (Lazy.force safe_env) devnull wr wr
    with Unix.Unix_error _ ->
      Unix.close rd; Unix.close wr; Unix.close devnull; -1 in
  Sys.chdir saved_cwd;
  Unix.close wr; Unix.close devnull;
  if pid < 0 then (Unix.close rd; None)
  else begin
    let buf = Buffer.create 4096 in
    let deadline = Unix.gettimeofday () +. (float_of_int timeout_ms /. 1000.0) in
    let chunk = Bytes.create 8192 in
    let alive = ref true in
    (try while !alive do
       let remaining = deadline -. Unix.gettimeofday () in
       if remaining <= 0.0 then alive := false
       else match Unix.select [rd] [] [] (min remaining 0.05) with
         | (_ :: _, _, _) ->
           let n = Unix.read rd chunk 0 8192 in
           if n = 0 then raise Exit
           else Buffer.add_subbytes buf chunk 0 n
         | _ -> ()
     done with Exit -> ());
    Unix.close rd;
    if not !alive then begin
      (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
      ignore (Unix.waitpid [] pid)
    end else
      ignore (Unix.waitpid [] pid);
    if Buffer.length buf > 0 then Some (Buffer.contents buf) else None
  end

let is_executable path =
  try let st = Unix.stat path in
    st.st_kind = Unix.S_REG && st.st_perm land 0o111 <> 0
  with Unix.Unix_error _ -> false

let is_script path =
  try
    let real = Unix.realpath path in
    let ic = open_in_bin real in
    let has_shebang =
      try let b = Bytes.create 2 in
        really_input ic b 0 2;
        Bytes.get b 0 = '#' && Bytes.get b 1 = '!'
      with End_of_file -> false in
    close_in ic;
    has_shebang
  with _ -> false

let elf_scan path needles =
  let found = Hashtbl.create 4 in
  let remaining () = List.filter (fun n -> not (Hashtbl.mem found n)) needles in
  (try
    let real = Unix.realpath path in
    let ic = open_in_bin real in
    let magic = Bytes.create 4 in
    really_input ic magic 0 4;
    if Bytes.get magic 0 = '\x7f' && Bytes.get magic 1 = 'E'
       && Bytes.get magic 2 = 'L' && Bytes.get magic 3 = 'F' then begin
      let max_needle = List.fold_left (fun m n -> max m (String.length n)) 0 needles in
      let chunk_size = 65536 in
      let buf = Bytes.create (chunk_size + max_needle) in
      let carry = ref 0 in
      let eof = ref false in
      while not !eof && remaining () <> [] do
        let n = (try input ic buf !carry chunk_size with End_of_file -> 0) in
        if n = 0 then eof := true
        else begin
          let total = !carry + n in
          List.iter (fun needle ->
            if not (Hashtbl.mem found needle) then begin
              let nlen = String.length needle in
              let i = ref 0 in
              while !i <= total - nlen do
                if Bytes.get buf !i = needle.[0] then begin
                  let ok = ref true in
                  for j = 1 to nlen - 1 do
                    if Bytes.get buf (!i + j) <> needle.[j] then ok := false
                  done;
                  if !ok then (Hashtbl.replace found needle true; i := total)
                  else incr i
                end else incr i
              done
            end
          ) (remaining ());
          let new_carry = min max_needle total in
          Bytes.blit buf (total - new_carry) buf 0 new_carry;
          carry := new_carry
        end
      done
    end;
    close_in ic
  with _ ->
    List.iter (fun n -> Hashtbl.replace found n true) needles);
  found

let nix_wrapper_target path =
  try
    let real = Unix.realpath path in
    let ic = open_in_bin real in
    let n = in_channel_length ic in
    if n > 65536 then (close_in ic; None)
    else begin
      let s = Bytes.create n in
      really_input ic s 0 n; close_in ic;
      let s = Bytes.to_string s in
      if not (contains_str s "makeCWrapper") then None
      else
        let re = Str.regexp "/nix/store/[a-z0-9]+-[^' \n\r\x00]+/bin/[a-zA-Z0-9._-]+" in
        try ignore (Str.search_forward re s 0);
          let target = Str.matched_string s in
          if Sys.file_exists target then Some target else None
        with Not_found -> None
    end
  with _ -> None

let skip_name name =
  String.length name = 0 || name = "-" || name.[0] = '.'
  || String.starts_with ~prefix:"lib" name
  || String.ends_with ~suffix:"-daemon" name
  || String.ends_with ~suffix:"-wrapped" name
  || String.ends_with ~suffix:".so" name
  || not (String.exists (fun c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9')) name)

type bin_class = Skip | Try_help | Try_native_and_help

let classify_binary bindir name =
  if is_nushell_builtin name || skip_name name then Skip
  else
    let path = Filename.concat bindir name in
    if not (is_executable path) then Skip
    else if is_script path then Try_help
    else
      let scan = elf_scan path ["-h"; "completion"] in
      if Hashtbl.mem scan "completion" then Try_native_and_help
      else if Hashtbl.mem scan "-h" then Try_help
      else if nix_wrapper_target path <> None then Try_help
      else Skip

let num_cores () =
  try
    let ic = open_in "/proc/cpuinfo" in
    let n = ref 0 in
    (try while true do
       if String.starts_with ~prefix:"processor" (input_line ic) then incr n
     done with End_of_file -> ());
    close_in ic; max 1 !n
  with _ -> 4

let try_native_completion bin_path =
  let patterns = [
    [bin_path; "completions"; "nushell"];
    [bin_path; "completion"; "nushell"];
    [bin_path; "--completions"; "nushell"];
    [bin_path; "--completion"; "nushell"];
    [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 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
    let result = parse_manpage_string contents in
    if result.entries <> [] then
      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
      Array.iter (fun file ->
        (try cmd_manpage (Filename.concat subdir file) with _ -> ())
      ) (Sys.readdir subdir)
  ) command_sections

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
  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
      Array.fold_left (fun acc f -> SSet.add (cmd_name_of_manpage f) acc)
        acc (Sys.readdir subdir)
    else acc
  ) SSet.empty command_sections

(* Parallel structured help resolver — returns (name, help_result) pairs
   like the old sequential version but forks per subcommand for parallelism. *)
let help_resolve_par ?(timeout=200) cmd rest name =
  let max_jobs = num_cores () in
  let queue = Queue.create () in
  Queue.push (rest, name, 0) queue;
  let results = ref [] in
  (* pending: (pid, rd, buf, rest, name, depth) *)
  let pending = ref [] in
  let collect rd buf q_rest q_name q_depth =
    drain_fd rd buf;
    (try Unix.close rd with _ -> ());
    let data = Buffer.contents buf in
    let result : (help_result * subcommand list) option =
      if String.length data > 0 then
        try Marshal.from_string data 0 with _ -> None
      else None in
    match result with
    | None -> ()
    | Some (r, subs) ->
      let at_limit = q_depth >= 5 || List.length !results >= max_resolve_results in
      results := (q_name, r) :: !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
        ) subs in
  let reap () =
    pending := List.filter (fun (pid, rd, buf, q_rest, q_name, q_depth) ->
      drain_fd rd buf;
      match Unix.waitpid [Unix.WNOHANG] pid with
      | (0, _) -> true
      | _ -> collect rd buf q_rest q_name q_depth; false
      | exception Unix.Unix_error (Unix.ECHILD, _, _) ->
        (try Unix.close rd with _ -> ()); false
    ) !pending in
  let wait_for_slot () =
    while List.length !pending >= max_jobs do
      reap ();
      if List.length !pending >= max_jobs then begin
        let fds = List.map (fun (_, rd, _, _, _, _) -> rd) !pending in
        ignore (Unix.select fds [] [] 0.05)
      end
    done in
  while not (Queue.is_empty queue) || !pending <> [] do
    while not (Queue.is_empty queue) do
      let (q_rest, q_name, q_depth) = Queue.pop queue in
      wait_for_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 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 subs = if at_limit then [] else r.subcommands in
                 Some (r, subs)) in
        let oc = Unix.out_channel_of_descr wr in
        Marshal.to_channel oc (result : (help_result * subcommand list) option) [];
        close_out oc;
        exit 0
      end else begin
        Unix.close wr;
        pending := (pid, rd, Buffer.create 4096, q_rest, q_name, q_depth) :: !pending
      end
    done;
    if !pending <> [] then begin
      reap ();
      if !pending <> [] && Queue.is_empty queue then begin
        let fds = List.map (fun (_, rd, _, _, _, _) -> rd) !pending in
        ignore (Unix.select fds [] [] 0.05)
      end
    end
  done;
  List.rev !results

(* Index: fork-per-binary pattern with pipe-based result marshaling.
   Each child handles one binary completely (including subcommand resolution)
   and marshals results back via pipe. Children use help_resolve_par
   which forks per subcommand for parallelism. *)
let cmd_index bindirs mandirs ignorelist help_only dir =
  ensure_dir 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
      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 ignorelist then (name, Skip)
        else if SSet.mem name help_only then (name, classify_binary bindir name)
        else if SSet.mem name manpaged then (name, Skip)
        else (name, classify_binary bindir name)
      ) bins in
      let pending = ref [] in
      let process_result name rd buf =
        drain_fd rd buf;
        (try Unix.close rd with _ -> ());
        let data = Buffer.contents buf in
        if String.length data > 0 then begin
          let result : [`Native of string | `Parsed of (string * help_result) list | `None] =
            try Marshal.from_string data 0 with _ -> `None in
          (match result with
          | `Native src ->
            write_native ~dir name src;
            incr n_results
          | `Parsed pairs ->
            List.iter (fun (cmd_name, r) ->
              if not (SSet.mem cmd_name !done_cmds) then begin
                write_result ~dir ~source:"help" cmd_name r;
                done_cmds := SSet.add cmd_name !done_cmds;
                incr n_results
              end
            ) pairs
          | `None -> ())
        end;
        done_cmds := SSet.add name !done_cmds in
      let reap () =
        pending := List.filter (fun (pid, rd, buf, name) ->
          drain_fd rd buf;
          match Unix.waitpid [Unix.WNOHANG] pid with
          | (0, _) -> true
          | _ ->
            process_result name rd buf;
            false
          | exception Unix.Unix_error (Unix.ECHILD, _, _) ->
            (try Unix.close rd with _ -> ()); false
        ) !pending in
      let wait_for_slot () =
        while List.length !pending >= max_jobs do
          reap ();
          if List.length !pending >= max_jobs then begin
            let fds = List.map (fun (_, rd, _, _) -> rd) !pending in
            ignore (Unix.select fds [] [] 0.05)
          end
        done in
      Array.iter (fun (name, cls) ->
        match cls with
        | Skip -> ()
        | Try_help | Try_native_and_help ->
          wait_for_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_par ~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, Buffer.create 4096, name) :: !pending
          end
      ) classified;
      while !pending <> [] do
        reap ();
        if !pending <> [] then begin
          let fds = List.map (fun (_, rd, _, _) -> rd) !pending in
          ignore (Unix.select fds [] [] 0.05)
        end
      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 ->
              let base_cmd = cmd_name_of_manpage file in
              if SSet.mem base_cmd help_only then ()
              else match process_manpage (Filename.concat subdir file) with
              | None -> ()
              | Some (cmd, result, subs) ->
                if not (SSet.mem cmd !done_cmds) then begin
                  write_result ~dir ~source:"manpage" cmd result;
                  done_cmds := SSet.add cmd !done_cmds;
                  incr n_results
                end;
                List.iter (fun (sub_cmd, sub_result) ->
                  if not (SSet.mem sub_cmd !done_cmds) then begin
                    write_result ~dir ~source:"manpage" sub_cmd sub_result;
                    done_cmds := SSet.add sub_cmd !done_cmds;
                    incr n_results
                  end
                ) subs
            ) files
          end
        ) command_sections
    end in
  List.iter2 index_bindir bindirs mandirs;
  Printf.printf "indexed %d commands into %s\n" !n_results dir

let cmd_dump dirs =
  let cmds = all_commands dirs in
  Printf.printf "%d commands\n" (List.length cmds);
  List.iter (fun cmd ->
    let src = match file_type_of dirs cmd with
      | Some s -> s | None -> "?" in
    Printf.printf "  %-40s [%s]\n" cmd src
  ) cmds

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
  with Not_found -> None

let resolve_and_cache ~dir name path =
  let pairs = help_resolve_par ~timeout:200 path [] name in
  if pairs <> [] then begin
    ensure_dir dir;
    List.iter (fun (cmd_name, r) -> write_result ~dir cmd_name r) pairs;
    Some pairs
  end else None

let completion_json value desc =
  Printf.sprintf "{\"value\":\"%s\",\"description\":\"%s\"}"
    (escape_json value) (escape_json desc)

let flag_completions prefix entries =
  let candidates = ref [] in
  List.iter (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

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
    let all_tokens = cmd_name :: rest in
    let partial_tokens = cmd_name :: (match rest with
      | _ :: _ -> List.rev (List.tl (List.rev rest))
      | _ -> []) 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),
       then fall back to treating the last token as partial *)
    let try_both () =
      match find_result all_tokens with
      | Some _ as r -> (r, "")
      | None -> (find_result partial_tokens, last_token) in
    let found, partial = try_both () in
    (* If not found at all, try on-the-fly resolution for the base command *)
    let result, partial = match found with
      | Some _ -> (found, partial)
      | None ->
        (match find_in_path cmd_name with
         | Some path ->
           (match resolve_and_cache ~dir:user_dir cmd_name path with
            | 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 cmd_query cmd dirs =
  match lookup_raw dirs cmd with
  | None ->
    Printf.eprintf "not found: %s\n" cmd; exit 1
  | Some data ->
    print_string data; print_newline ()

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 dir ignore help_only = function
    | [] -> (List.rev prefixes, dir, ignore, help_only)
    | "--dir" :: path :: rest -> go prefixes path ignore help_only rest
    | "--ignore" :: path :: rest -> go prefixes dir (SSet.union ignore (load_ignorelist path)) help_only rest
    | "--help-only" :: path :: rest -> go prefixes dir ignore (SSet.union help_only (load_ignorelist path)) rest
    | prefix :: rest -> go (prefix :: prefixes) dir ignore help_only rest in
  go [] (default_store_path ()) SSet.empty SSet.empty args

let parse_dir_args args =
  let rec go user_dir system_dirs rest_args = function
    | [] -> (user_dir, system_dirs, List.rev rest_args)
    | "--dir" :: path :: rest -> go path system_dirs rest_args rest
    | "--system-dir" :: path :: rest -> go user_dir (path :: system_dirs) rest_args rest
    | arg :: rest -> go user_dir system_dirs (arg :: rest_args) rest in
  go (default_store_path ()) [] [] args

let () =
  match Array.to_list Sys.argv |> List.tl with
  | "index" :: rest ->
    let (prefixes, dir, ignorelist, help_only) = 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 help_only dir
  | "complete" :: rest ->
    let (user_dir, system_dirs, spans) = parse_dir_args rest in
    cmd_complete spans user_dir system_dirs
  | "query" :: rest ->
    let (user_dir, system_dirs, args) = parse_dir_args rest in
    (match args with
     | [cmd] -> cmd_query cmd (user_dir :: system_dirs)
     | _ -> Printf.eprintf "error: query CMD [--dir PATH] [--system-dir PATH]\n"; exit 1)
  | "dump" :: rest ->
    let (user_dir, system_dirs, _) = parse_dir_args rest in
    cmd_dump (user_dir :: system_dirs)
  | ["manpage"; file] -> cmd_manpage file
  | ["manpage-dir"; dir] -> cmd_manpage_dir dir
  | _ -> usage ()