adopt better fp patterns
This commit is contained in:
atagen
parent
18c97eacd0
commit
163e330716
4 changed files with 111 additions and 83 deletions
157
lib/manpage.ml
157
lib/manpage.ml
|
|
@ -560,105 +560,108 @@ let mdoc_text_of line =
|
|||
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 entries = ref [] in
|
||||
let positionals = ref [] in
|
||||
let rec skip_to_el = function
|
||||
| [] -> []
|
||||
| Macro ("El", _) :: rest -> rest
|
||||
| _ :: rest -> skip_to_el rest
|
||||
in
|
||||
let collect_desc rest =
|
||||
let rec go acc = function
|
||||
| [] -> (acc, [])
|
||||
| (Macro ("It", _) | Macro ("El", _)
|
||||
| Macro ("Sh", _) | Macro ("Ss", _)) :: _ as rest -> (acc, rest)
|
||||
| line :: rest ->
|
||||
go (match mdoc_text_of line with Some s -> s :: acc | None -> acc) rest
|
||||
in
|
||||
let parts, rest = go [] 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_mdoc_it args =
|
||||
let words = String.split_on_char ' ' args
|
||||
|> List.filter (fun w -> w <> "" && w <> "Ns") in
|
||||
match words with
|
||||
| "Fl" :: c :: _ when String.length c = 1 && is_alphanumeric c.[0] ->
|
||||
let param = match words with
|
||||
| _ :: _ :: "Ar" :: p :: _ -> Some (Mandatory p)
|
||||
| _ -> None
|
||||
in
|
||||
Some { switch = Short c.[0]; param; desc = "" }
|
||||
| "Fl" :: name :: _ when String.length name > 1 && name.[0] = '-' ->
|
||||
let long = String.sub name 1 (String.length name - 1) in
|
||||
let param = match words with
|
||||
| _ :: _ :: "Ar" :: p :: _ -> Some (Mandatory p)
|
||||
| _ -> None
|
||||
in
|
||||
Some { switch = Long long; param; desc = "" }
|
||||
| _ -> None
|
||||
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 = function
|
||||
| [] -> []
|
||||
| Macro ("El", _) :: rest -> rest
|
||||
let rec parse_option_list entries = function
|
||||
| [] -> (entries, [])
|
||||
| Macro ("El", _) :: rest -> (entries, rest)
|
||||
| Macro ("It", args) :: rest ->
|
||||
let desc, rest = collect_desc rest in
|
||||
(match parse_mdoc_it args with
|
||||
| Some e -> entries := { e with desc } :: !entries
|
||||
| None -> ());
|
||||
parse_option_list rest
|
||||
| _ :: rest -> parse_option_list 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 = function
|
||||
| [] -> ()
|
||||
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 begin
|
||||
let desc, rest = collect_desc rest in
|
||||
(match parse_mdoc_it it_args with
|
||||
| Some e -> entries := { e with desc } :: !entries
|
||||
| None -> ());
|
||||
scan (parse_option_list rest)
|
||||
end else
|
||||
scan (skip_to_el rest)
|
||||
| Macro ("Bl", _) :: rest -> scan (skip_to_el rest)
|
||||
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" ->
|
||||
scan (parse_synopsis rest)
|
||||
| _ :: rest -> scan rest
|
||||
and parse_synopsis = function
|
||||
| [] -> []
|
||||
| Macro ("Sh", _) :: _ as rest -> rest
|
||||
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 words = String.split_on_char ' ' args
|
||||
|> List.filter (fun w -> w <> "") in
|
||||
(match words with
|
||||
| name :: _ when String.length name >= 2 ->
|
||||
let variadic = List.mem "..." words in
|
||||
positionals := { pos_name = String.lowercase_ascii name;
|
||||
optional = false; variadic } :: !positionals
|
||||
| _ -> ());
|
||||
parse_synopsis 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
|
||||
(match words with
|
||||
| "Ar" :: name :: _ when String.length name >= 2 ->
|
||||
let variadic = List.mem "..." words in
|
||||
positionals := { pos_name = String.lowercase_ascii name;
|
||||
optional = true; variadic } :: !positionals
|
||||
| _ -> ());
|
||||
parse_synopsis rest
|
||||
| _ :: rest -> parse_synopsis rest
|
||||
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
|
||||
scan classified;
|
||||
let seen = Hashtbl.create 8 in
|
||||
let positionals = List.rev !positionals |> List.filter (fun p ->
|
||||
if Hashtbl.mem seen p.pos_name then false
|
||||
else (Hashtbl.replace seen p.pos_name true; true)) in
|
||||
{ entries = List.rev !entries; subcommands = []; positionals }
|
||||
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 }
|
||||
|
||||
(* --- Top-level API --- *)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue