open Parser

(* --- Groff escape/formatting stripper --- *)

let strip_groff_escapes s =
  let buf = Buffer.create (String.length s) in
  let len = String.length s in
  let i = ref 0 in
  let last = ref '\000' in
  let put c = Buffer.add_char buf c; last := c in
  let is_alnum c =
    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9')
  in
  while !i < len do
    if s.[!i] = '\\' && !i + 1 < len then begin
      let next = s.[!i + 1] in
      match next with
      | 'f' ->
        (* Font escape: \fB, \fI, \fP, \fR, \f(XX, \f[...] *)
        if !i + 2 < len then begin
          let fc = s.[!i + 2] in
          (* Insert space before italic font to preserve word boundaries
             e.g. \fB--max-results\fR\fIcount\fR → "--max-results count" *)
          if fc = 'I' && is_alnum !last then put ' ';
          if fc = '(' then
            i := !i + 5  (* \f(XX *)
          else if fc = '[' then begin
            i := !i + 3;
            while !i < len && s.[!i] <> ']' do incr i done;
            if !i < len then incr i
          end else
            i := !i + 3  (* \fX *)
        end else
          i := !i + 2
      | '-' ->
        put '-';
        i := !i + 2
      | '&' | '/' | ',' ->
        (* Zero-width characters *)
        i := !i + 2
      | '(' ->
        (* Two-char named character: \(aq, \(lq, \(rq, etc. *)
        if !i + 3 < len then begin
          let name = String.sub s (!i + 2) 2 in
          (match name with
           | "aq" -> put '\''
           | "lq" | "Lq" -> put '"'
           | "rq" | "Rq" -> put '"'
           | "em" | "en" -> put '-'
           | _ -> ());
          i := !i + 4
        end else
          i := !i + 2
      | '[' ->
        (* Named character: \[...] *)
        i := !i + 2;
        let start = !i in
        while !i < len && s.[!i] <> ']' do incr i done;
        if !i < len then begin
          let name = String.sub s start (!i - start) in
          (match name with
           | "aq" -> put '\''
           | "lq" | "Lq" -> put '"'
           | "rq" | "Rq" -> put '"'
           | _ -> ());
          incr i
        end
      | 's' ->
        (* Size escape: \sN, \s+N, \s-N, \s'N' *)
        i := !i + 2;
        if !i < len && (s.[!i] = '+' || s.[!i] = '-') then incr i;
        if !i < len && s.[!i] >= '0' && s.[!i] <= '9' then incr i;
        if !i < len && s.[!i] >= '0' && s.[!i] <= '9' then incr i
      | 'm' ->
        (* Color escape: \m[...] *)
        i := !i + 2;
        if !i < len && s.[!i] = '[' then begin
          incr i;
          while !i < len && s.[!i] <> ']' do incr i done;
          if !i < len then incr i
        end
      | 'X' ->
        (* Device control: \X'...' *)
        i := !i + 2;
        if !i < len && s.[!i] = '\'' then begin
          incr i;
          while !i < len && s.[!i] <> '\'' do incr i done;
          if !i < len then incr i
        end
      | '*' ->
        (* String variable: \*X or \*(XX or \*[...] *)
        i := !i + 2;
        if !i < len then begin
          if s.[!i] = '(' then
            i := !i + 2
          else if s.[!i] = '[' then begin
            incr i;
            while !i < len && s.[!i] <> ']' do incr i done;
            if !i < len then incr i
          end else
            incr i
        end
      | 'n' ->
        (* Number register: \nX or \n(XX or \n[...] *)
        i := !i + 2;
        if !i < len then begin
          if s.[!i] = '(' then
            i := !i + 2
          else if s.[!i] = '[' then begin
            incr i;
            while !i < len && s.[!i] <> ']' do incr i done;
            if !i < len then incr i
          end else
            incr i
        end
      | 'e' ->
        put '\\';
        i := !i + 2
      | '\\' ->
        put '\\';
        i := !i + 2
      | ' ' ->
        put ' ';
        i := !i + 2
      | _ ->
        (* Unknown escape, skip *)
        i := !i + 2
    end else begin
      put s.[!i];
      incr i
    end
  done;
  Buffer.contents buf

(* Strip inline macro formatting: .BI, .BR, .IR, etc.
   These macros alternate between fonts for their arguments.
   We just concatenate the arguments. *)
let strip_inline_macro_args s =
  (* Arguments are separated by spaces, quoted strings are kept together *)
  let buf = Buffer.create (String.length s) in
  let len = String.length s in
  let i = ref 0 in
  while !i < len do
    if s.[!i] = '"' then begin
      incr i;
      while !i < len && s.[!i] <> '"' do
        Buffer.add_char buf s.[!i];
        incr i
      done;
      if !i < len then incr i
    end else if s.[!i] = ' ' || s.[!i] = '\t' then begin
      incr i
    end else begin
      Buffer.add_char buf s.[!i];
      incr i
    end
  done;
  Buffer.contents buf

let strip_groff line =
  let s = strip_groff_escapes line in
  String.trim s

(* --- Line classification --- *)

type groff_line =
  | Macro of string * string   (* e.g. ("SH", "OPTIONS") or ("TP", "") *)
  | Text of string             (* plain text after stroff stripping *)
  | Blank
  | Comment

let classify_line line =
  let len = String.length line in
  if len = 0 then Blank
  else if len >= 2 && line.[0] = '.' && line.[1] = '\\' && (len < 3 || line.[2] = '"') then
    Comment
  else if len >= 3 && line.[0] = '\\' && line.[1] = '"' then
    Comment
  else if line.[0] = '.' || line.[0] = '\'' then begin
    (* Macro line *)
    let rest = String.sub line 1 (len - 1) in
    let rest = String.trim rest in
    (* Split into macro name and arguments *)
    let space_pos =
      try Some (String.index rest ' ')
      with Not_found ->
        try Some (String.index rest '\t')
        with Not_found -> None
    in
    match space_pos with
    | Some pos ->
      let name = String.sub rest 0 pos in
      let args = String.trim (String.sub rest (pos + 1) (String.length rest - pos - 1)) in
      (* Strip quotes from args *)
      let args =
        let alen = String.length args in
        if alen >= 2 && args.[0] = '"' && args.[alen - 1] = '"' then
          String.sub args 1 (alen - 2)
        else args
      in
      Macro (name, args)
    | None ->
      Macro (rest, "")
  end else begin
    let stripped = strip_groff line in
    if String.length stripped = 0 then Blank
    else Text stripped
  end

(* Check for dot-backslash-quote style comments more carefully *)
let is_comment_line line =
  let len = String.length line in
  (len >= 3 && line.[0] = '.' && line.[1] = '\\' && line.[2] = '"')
  || (len >= 2 && line.[0] = '\\' && line.[1] = '"')

let classify_line line =
  if is_comment_line line then Comment
  else classify_line line

(* --- Section extraction --- *)

let extract_options_section lines =
  let classified = List.map classify_line lines in
  let rec collect_until_next_sh lines acc =
    match lines with
    | [] -> List.rev acc
    | Macro ("SH", _) :: _ -> List.rev acc
    | line :: rest -> collect_until_next_sh rest (line :: acc)
  in
  let is_options_section name =
    let s = String.uppercase_ascii (String.trim name) in
    s = "OPTIONS"
    || (String.length s > 0 &&
        try let _ = Str.search_forward (Str.regexp_string "OPTION") s 0 in true
        with Not_found -> false)
  in
  (* First pass: look for OPTIONS section *)
  let rec find_options = function
    | [] -> None
    | Macro ("SH", args) :: rest when is_options_section args ->
      Some (collect_until_next_sh rest [])
    | _ :: rest -> find_options rest
  in
  (* Fallback: DESCRIPTION section *)
  let rec find_description = function
    | [] -> []
    | Macro ("SH", args) :: rest
      when String.uppercase_ascii (String.trim args) = "DESCRIPTION" ->
      collect_until_next_sh rest []
    | _ :: rest -> find_description rest
  in
  match find_options classified with
  | Some section -> section
  | None -> find_description classified

(* --- Strategy-based entry extraction --- *)

(* Collect text lines until next macro or blank *)
let rec collect_text_lines lines acc =
  match lines with
  | Text s :: rest -> collect_text_lines rest (s :: acc)
  | _ -> (String.concat " " (List.rev acc), lines)

(* Parse a tag line to extract entry using the Angstrom switch_parser *)
let parse_tag_to_entry tag desc =
  let tag = strip_groff_escapes tag in
  let tag = String.trim tag in
  match Angstrom.parse_string ~consume:Angstrom.Consume.Prefix
          (Angstrom.lift2 (fun sw p -> (sw, p)) switch_parser param_parser) tag with
  | Ok (switch, param) -> Some { switch; param; desc }
  | Error _ -> None

(* Extract tag text from a macro line (.B, .I preserve spaces; .BI/.BR/.IR alternate) *)
let tag_of_macro name args =
  match name with
  | "B" | "I" -> strip_groff_escapes args |> String.trim
  | _ -> strip_inline_macro_args args |> strip_groff_escapes |> String.trim

(* Strategy A: .TP style (most common — GNU coreutils, help2man) *)
let strategy_tp lines =
  let rec walk lines acc =
    match lines with
    | [] -> List.rev acc
    | Macro ("TP", _) :: rest ->
      (* Next line is the tag — could be Text or a formatting macro *)
      begin match rest with
        | Text tag :: rest2 ->
          let (desc, rest3) = collect_text_lines rest2 [] in
          let entry = parse_tag_to_entry tag desc in
          walk rest3 (match entry with Some e -> e :: acc | None -> acc)
        | Macro (("B" | "I" | "BI" | "BR" | "IR") as m, args) :: rest2 ->
          let tag = tag_of_macro m args in
          let (desc, rest3) = collect_text_lines rest2 [] in
          let entry = parse_tag_to_entry tag desc in
          walk rest3 (match entry with Some e -> e :: acc | None -> acc)
        | _ -> walk rest acc
      end
    | _ :: rest -> walk rest acc
  in
  walk lines []

(* Strategy B: .IP style (curl, hand-written) *)
let strategy_ip lines =
  let rec walk lines acc =
    match lines with
    | [] -> List.rev acc
    | Macro ("IP", tag) :: rest ->
      let tag = strip_groff_escapes tag in
      let (desc, rest2) = collect_text_lines rest [] in
      let entry = parse_tag_to_entry tag desc in
      walk rest2 (match entry with Some e -> e :: acc | None -> acc)
    | _ :: rest -> walk rest acc
  in
  walk lines []

(* Strategy C: .PP + .RS/.RE style (git, DocBook) *)
let strategy_pp_rs lines =
  let rec walk lines acc =
    match lines with
    | [] -> List.rev acc
    | Macro ("PP", _) :: rest ->
      begin match rest with
        | Text tag :: rest2 ->
          (* Look for .RS ... text ... .RE *)
          let rec collect_rs lines desc_acc =
            match lines with
            | Macro ("RS", _) :: rest3 ->
              collect_in_rs rest3 desc_acc
            | Text s :: rest3 ->
              (* Sometimes description follows directly *)
              collect_rs rest3 (s :: desc_acc)
            | _ -> (String.concat " " (List.rev desc_acc), lines)
          and collect_in_rs lines desc_acc =
            match lines with
            | Macro ("RE", _) :: rest3 ->
              (String.concat " " (List.rev desc_acc), rest3)
            | Text s :: rest3 ->
              collect_in_rs rest3 (s :: desc_acc)
            | Macro ("PP", _) :: _ | Macro ("SH", _) :: _ ->
              (String.concat " " (List.rev desc_acc), lines)
            | _ :: rest3 -> collect_in_rs rest3 desc_acc
            | [] -> (String.concat " " (List.rev desc_acc), [])
          in
          let (desc, rest3) = collect_rs rest2 [] in
          let entry = parse_tag_to_entry tag desc in
          walk rest3 (match entry with Some e -> e :: acc | None -> acc)
        | _ -> walk rest acc
      end
    | _ :: rest -> walk rest acc
  in
  walk lines []

(* Strategy D: Deroff fallback — strip all groff, use help text parser *)
let strategy_deroff_lines lines =
  let buf = Buffer.create 256 in
  List.iter (fun line ->
    match line with
    | Text s ->
      Buffer.add_string buf s;
      Buffer.add_char buf '\n'
    | Macro (("BI" | "BR" | "IR" | "B" | "I"), args) ->
      let text = strip_inline_macro_args args in
      let text = strip_groff_escapes text in
      Buffer.add_string buf text;
      Buffer.add_char buf '\n'
    | Blank -> Buffer.add_char buf '\n'
    | _ -> ()
  ) lines;
  let text = Buffer.contents buf in
  match parse_help text with
  | Ok result -> result.entries
  | Error _ -> []

(* Strategy E: Nix3-style bullet .IP with .UR/.UE hyperlinks *)
let strategy_nix lines =
  let is_bullet_ip args =
    String.length (String.trim args) > 0
  in
  let rec walk lines acc =
    match lines with
    | [] -> List.rev acc
    | Macro ("IP", args) :: rest when is_bullet_ip args ->
      (* Collect tag: skip UR/UE macros, collect Text lines *)
      let rec collect_tag lines parts =
        match lines with
        | Macro ("UR", _) :: rest2 -> collect_tag rest2 parts
        | Macro ("UE", _) :: rest2 -> collect_tag rest2 parts
        | Text s :: rest2 -> collect_tag rest2 (s :: parts)
        | _ -> (String.concat " " (List.rev parts), lines)
      in
      let (tag, rest2) = collect_tag rest [] in
      (* Collect description after the description .IP marker *)
      let rec collect_desc lines parts =
        match lines with
        | Macro ("IP", dargs) :: rest3 when not (is_bullet_ip dargs) ->
          collect_desc_text rest3 parts
        | _ -> (String.concat " " (List.rev parts), lines)
      and collect_desc_text lines parts =
        match lines with
        | Text s :: rest3 -> collect_desc_text rest3 (s :: parts)
        | Macro ("IP", args) :: _ when is_bullet_ip args ->
          (String.concat " " (List.rev parts), lines)
        | Macro (("SS" | "SH"), _) :: _ ->
          (String.concat " " (List.rev parts), lines)
        | Macro ("RS", _) :: rest3 ->
          skip_rs rest3 parts 1
        | Macro ("IP", _) :: rest3 ->
          (* Non-bullet IP = continuation paragraph *)
          collect_desc_text rest3 parts
        | Macro _ :: rest3 -> collect_desc_text rest3 parts
        | Blank :: rest3 -> collect_desc_text rest3 parts
        | Comment :: rest3 -> collect_desc_text rest3 parts
        | [] -> (String.concat " " (List.rev parts), [])
      and skip_rs lines parts depth =
        match lines with
        | Macro ("RE", _) :: rest3 ->
          if depth <= 1 then collect_desc_text rest3 parts
          else skip_rs rest3 parts (depth - 1)
        | Macro ("RS", _) :: rest3 -> skip_rs rest3 parts (depth + 1)
        | _ :: rest3 -> skip_rs rest3 parts depth
        | [] -> (String.concat " " (List.rev parts), [])
      in
      let (desc, rest3) = collect_desc rest2 [] in
      let entry = parse_tag_to_entry tag desc in
      walk rest3 (match entry with Some e -> e :: acc | None -> acc)
    | _ :: rest -> walk rest acc
  in
  walk lines []

(* Count macros of a given type *)
let count_macro name lines =
  List.fold_left (fun n line ->
    match line with Macro (m, _) when m = name -> n + 1 | _ -> n
  ) 0 lines

(* Auto-detect and try strategies, return the one with most entries *)
let extract_entries lines =
  let tp = count_macro "TP" lines
  and ip = count_macro "IP" lines
  and pp = count_macro "PP" lines
  and rs = count_macro "RS" lines
  and ur = count_macro "UR" lines in
  let specialized = List.filter_map Fun.id [
    (if tp > 0 then Some ("TP", strategy_tp lines) else None);
    (if ip > 0 then Some ("IP", strategy_ip lines) else None);
    (if pp > 0 && rs > 0 then Some ("PP+RS", strategy_pp_rs lines) else None);
    (if ur > 0 && ip > 0 then Some ("nix", strategy_nix lines) else None);
  ] in
  let candidates = match List.filter (fun (_, e) -> e <> []) specialized with
    | [] -> [("deroff", strategy_deroff_lines lines)]
    | filtered -> filtered
  in
  List.fold_left (fun (_, best) (name, entries) ->
    if List.length entries >= List.length best then (name, entries)
    else (name, best)
  ) ("none", []) candidates |> snd

(* --- NAME section description extraction --- *)

let extract_name_description contents =
  let lines = String.split_on_char '\n' contents in
  let classified = List.map classify_line lines in
  let rec find = function
    | [] -> None
    | Macro ("SH", args) :: rest
      when String.uppercase_ascii (String.trim args) = "NAME" ->
      collect rest []
    | _ :: rest -> find rest
  and collect lines acc =
    match lines with
    | Macro ("SH", _) :: _ | [] -> finish acc
    | Text s :: rest -> collect rest (s :: acc)
    | Macro (("B" | "BI" | "BR" | "I" | "IR"), args) :: rest ->
      let s = strip_inline_macro_args args |> strip_groff_escapes |> String.trim in
      collect rest (if String.length s > 0 then s :: acc else acc)
    | Macro ("Nm", args) :: rest ->
      let s = strip_groff_escapes args |> String.trim in
      collect rest (if String.length s > 0 then s :: acc else acc)
    | Macro ("Nd", args) :: rest ->
      let s = strip_groff_escapes args |> String.trim in
      collect rest (if String.length s > 0 then ("\\- " ^ s) :: acc else acc)
    | _ :: rest -> collect rest acc
  and finish acc =
    let full = String.concat " " (List.rev acc) |> String.trim in
    (* NAME lines look like: "git-add \- Add file contents to the index" *)
    let sep = Str.regexp {| *\\- *\| +- +|} in
    match Str.bounded_split sep full 2 with
    | [_; desc] -> Some (String.trim desc)
    | _ -> None
  in
  find classified

(* --- SYNOPSIS command name extraction --- *)

let extract_synopsis_command_lines lines =
  let classified = List.map classify_line lines in
  let is_synopsis name =
    let s = String.uppercase_ascii (String.trim name) in
    s = "SYNOPSIS"
  in
  let extract_cmd line =
    let words = String.split_on_char ' ' (String.trim line) in
    let words = List.filter (fun w -> String.length w > 0) words in
    let is_cmd_char = function
      | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' | '.' -> true
      | _ -> false
    in
    let rec take = function
      | [] -> []
      | w :: rest ->
        if String.length w > 0
           && (w.[0] = '[' || w.[0] = '-' || w.[0] = '<'
               || w.[0] = '(' || w.[0] = '{')
        then []
        else if String.for_all is_cmd_char w then
          w :: take rest
        else []
    in
    match take words with
    | [] -> None
    | cmd -> Some (String.concat " " cmd)
  in
  let rec find = function
    | [] -> None
    | Macro ("SH", args) :: rest when is_synopsis args -> collect rest
    | _ :: rest -> find rest
  and collect = function
    | [] -> None
    | Macro ("SH", _) :: _ -> None
    | Text s :: _ ->
      let s = String.trim s in
      if String.length s > 0 then extract_cmd s else None
    | Macro (("B" | "BI" | "BR"), args) :: _ ->
      let s = strip_inline_macro_args args |> strip_groff_escapes |> String.trim in
      if String.length s > 0 then extract_cmd s else None
    | _ :: rest -> collect rest
  in
  find classified

let extract_synopsis_command contents =
  let lines = String.split_on_char '\n' contents in
  extract_synopsis_command_lines lines

(* --- SYNOPSIS positional extraction --- *)

let extract_synopsis_positionals_lines lines =
  let classified = List.map classify_line lines in
  let is_synopsis name =
    String.uppercase_ascii (String.trim name) = "SYNOPSIS"
  in
  let rec find = function
    | [] -> []
    | Macro ("SH", args) :: rest when is_synopsis args -> collect rest []
    | _ :: rest -> find rest
  and collect lines acc =
    match lines with
    | [] -> finish acc
    | Macro ("SH", _) :: _ -> finish acc
    | Macro ("SS", _) :: _ -> finish acc
    | Macro ("br", _) :: _ -> finish acc
    | Text s :: rest ->
      let s = strip_groff_escapes s |> String.trim in
      collect rest (if String.length s > 0 then s :: acc else acc)
    | Macro (("B" | "BI" | "BR" | "I" | "IR" | "IB" | "RB" | "RI"), args) :: rest ->
      let s = strip_inline_macro_args args |> strip_groff_escapes |> String.trim in
      collect rest (if String.length s > 0 then s :: acc else acc)
    | _ :: rest -> collect rest acc
  and finish acc =
    let parts = List.rev acc in
    let full = String.concat " " parts |> String.trim in
    if String.length full = 0 then []
    else
      let cmd_end = skip_command_prefix full in
      let args = String.sub full cmd_end (String.length full - cmd_end) in
      parse_usage_args args
  in
  find classified

(* --- mdoc (BSD) format support --- *)

let is_mdoc lines =
  List.exists (fun l ->
    match classify_line l with Macro ("Sh", _) -> true | _ -> false
  ) lines

let mdoc_text_of line =
  match line with
  | Text s -> Some (strip_groff_escapes s)
  | Macro (m, args) ->
    (match m with
     | "Pp" | "Bl" | "El" | "Sh" | "Ss" | "Os" | "Dd" | "Dt"
     | "Oo" | "Oc" | "Op" -> None
     | _ ->
       let s = strip_groff_escapes args |> String.trim in
       if s = "" then None else Some s)
  | _ -> None

let parse_mdoc_it args =
  let words = String.split_on_char ' ' args
              |> List.filter (fun w -> w <> "" && w <> "Ns") in
  let param = match words with
    | _ :: _ :: "Ar" :: p :: _ -> Some (Mandatory p)
    | _ -> None
  in
  match words with
  | "Fl" :: c :: _ when String.length c = 1 && is_alphanumeric c.[0] ->
    Some { switch = Short c.[0]; param; desc = "" }
  | "Fl" :: name :: _ when String.length name > 1 && name.[0] = '-' ->
    Some { switch = Long (String.sub name 1 (String.length name - 1)); param; desc = "" }
  | _ -> None

let positional_of_mdoc_line optional args =
  let words = String.split_on_char ' ' args
              |> List.filter (fun w -> w <> "") in
  match words with
  | name :: _ when String.length name >= 2 ->
    Some { pos_name = String.lowercase_ascii name;
           optional; variadic = List.mem "..." words }
  | _ -> None

let parse_mdoc_lines lines =
  let classified = List.map classify_line lines in
  let rec skip_to_el = function
    | [] -> []
    | Macro ("El", _) :: rest -> rest
    | _ :: rest -> skip_to_el rest
  in
  let rec collect_desc acc = function
    | [] -> (acc, [])
    | (Macro ("It", _) | Macro ("El", _)
      | Macro ("Sh", _) | Macro ("Ss", _)) :: _ as rest -> (acc, rest)
    | line :: rest ->
      collect_desc (match mdoc_text_of line with Some s -> s :: acc | None -> acc) rest
  in
  let desc_of rest =
    let parts, rest = collect_desc [] rest in
    (String.concat " " (List.rev parts) |> String.trim, rest)
  in
  let parse_it args rest entries =
    let desc, rest = desc_of rest in
    let entries = match parse_mdoc_it args with
      | Some e -> { e with desc } :: entries
      | None -> entries
    in
    (entries, rest)
  in
  let rec parse_option_list entries = function
    | [] -> (entries, [])
    | Macro ("El", _) :: rest -> (entries, rest)
    | Macro ("It", args) :: rest ->
      let entries, rest = parse_it args rest entries in
      parse_option_list entries rest
    | _ :: rest -> parse_option_list entries rest
  in
  let rec scan entries positionals = function
    | [] -> (entries, positionals)
    | Macro ("Bl", _) :: Macro ("It", it_args) :: rest ->
      let words = String.split_on_char ' ' it_args
                  |> List.filter (fun w -> w <> "") in
      if (match words with "Fl" :: _ -> true | _ -> false) then
        let entries, rest = parse_it it_args rest entries in
        let entries, rest = parse_option_list entries rest in
        scan entries positionals rest
      else
        scan entries positionals (skip_to_el rest)
    | Macro ("Bl", _) :: rest -> scan entries positionals (skip_to_el rest)
    | Macro ("Sh", args) :: rest
      when String.uppercase_ascii (String.trim args) = "SYNOPSIS" ->
      let positionals, rest = parse_synopsis positionals rest in
      scan entries positionals rest
    | _ :: rest -> scan entries positionals rest
  and parse_synopsis positionals = function
    | [] -> (positionals, [])
    | Macro ("Sh", _) :: _ as rest -> (positionals, rest)
    | Macro ("Ar", args) :: rest ->
      let positionals = match positional_of_mdoc_line false args with
        | Some p -> p :: positionals | None -> positionals in
      parse_synopsis positionals rest
    | Macro ("Op", args) :: rest ->
      let words = String.split_on_char ' ' args
                  |> List.filter (fun w -> w <> "") in
      let positionals = match words with
        | "Ar" :: _ ->
          (match positional_of_mdoc_line true args with
           | Some p -> p :: positionals | None -> positionals)
        | _ -> positionals in
      parse_synopsis positionals rest
    | _ :: rest -> parse_synopsis positionals rest
  in
  let entries, positionals = scan [] [] classified in
  let positionals =
    List.rev positionals
    |> List.fold_left (fun (seen, acc) p ->
         if List.mem p.pos_name seen then (seen, acc)
         else (p.pos_name :: seen, p :: acc)
       ) ([], [])
    |> snd |> List.rev
  in
  { entries = List.rev entries; subcommands = []; positionals; description = "" }

(* --- Top-level API --- *)

let parse_manpage_lines lines =
  if is_mdoc lines then
    parse_mdoc_lines lines
  else begin
    let options_section = extract_options_section lines in
    let entries = extract_entries options_section in
    let positionals = extract_synopsis_positionals_lines lines in
    { entries; subcommands = []; positionals; description = "" }
  end

let parse_manpage_string contents =
  let lines = String.split_on_char '\n' contents in
  let result = parse_manpage_lines lines in
  let description = match extract_name_description contents with
    | Some d -> d | None -> "" in
  { result with description }

(* --- Clap-style SUBCOMMAND section extraction --- *)
(* Manpages generated by clap (Rust) put each subcommand under its own
   .SH SUBCOMMAND header with a Usage: line giving the name. *)

let extract_subcommand_sections contents =
  let lines = String.split_on_char '\n' contents in
  let classified = List.map classify_line lines in
  (* Split into sections at .SH boundaries *)
  let rec collect_sections acc current_name current_lines = function
    | [] ->
      let acc = match current_name with
        | Some n -> (n, List.rev current_lines) :: acc
        | None -> acc in
      List.rev acc
    | Macro ("SH", args) :: rest ->
      let acc = match current_name with
        | Some n -> (n, List.rev current_lines) :: acc
        | None -> acc in
      let name = String.uppercase_ascii (String.trim args) in
      if name = "SUBCOMMAND" || name = "SUBCOMMANDS" then
        collect_sections acc (Some name) [] rest
      else
        collect_sections acc None [] rest
    | line :: rest ->
      collect_sections acc current_name (line :: current_lines) rest
  in
  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) ->
    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)
                 |> strip_groff_escapes |> String.trim in
      let desc = Str.global_replace (Str.regexp "`\\([^`]*\\)`") "\\1" desc in
      Some (subcmd_name, desc, { entries; subcommands = []; positionals = []; description = desc })
  ) sections

let read_manpage_file path =
  if Filename.check_suffix path ".gz" then begin
    let ic = Gzip.open_in path in
    let buf = Buffer.create 8192 in
    let chunk = Bytes.create 8192 in
    (try while true do
       let n = Gzip.input ic chunk 0 8192 in
       if n = 0 then raise Exit
       else Buffer.add_subbytes buf chunk 0 n
     done with Exit | End_of_file -> ());
    Gzip.close_in ic;
    Buffer.contents buf
  end else begin
    let ic = open_in path in
    let n = in_channel_length ic in
    let s = Bytes.create n in
    really_input ic s 0 n;
    close_in ic;
    Bytes.to_string s
  end

let parse_manpage_file path =
  read_manpage_file path |> parse_manpage_string