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 --- *)
|
||||
|
||||
|
|
|
|||
|
|
@ -122,10 +122,24 @@ let format_positional p =
|
|||
let typ = nushell_type_of_param (String.uppercase_ascii p.pos_name) in
|
||||
Printf.sprintf " %s%s%s: %s" prefix name suffix typ
|
||||
|
||||
let fixup_positionals positionals =
|
||||
(* Nushell rules: no required after optional, only one rest param *)
|
||||
List.fold_left (fun (saw_opt, saw_rest, acc) p ->
|
||||
if p.variadic then
|
||||
if saw_rest then (saw_opt, saw_rest, acc)
|
||||
else (true, true, p :: acc)
|
||||
else if saw_opt then
|
||||
(true, saw_rest, { p with optional = true } :: acc)
|
||||
else
|
||||
(p.optional, saw_rest, p :: acc)
|
||||
) (false, false, []) positionals
|
||||
|> fun (_, _, acc) -> List.rev acc
|
||||
|
||||
let extern_of cmd_name result =
|
||||
let entries = dedup_entries result.entries in
|
||||
let cmd = escape_nu cmd_name in
|
||||
let pos_lines = List.map (fun p -> format_positional p ^ "\n") result.positionals in
|
||||
let positionals = fixup_positionals result.positionals in
|
||||
let pos_lines = List.map (fun p -> format_positional p ^ "\n") positionals in
|
||||
let flags = List.map (fun e -> format_flag e ^ "\n") entries in
|
||||
let main = Printf.sprintf "export extern \"%s\" [\n%s%s]\n" cmd (String.concat "" pos_lines) (String.concat "" flags) in
|
||||
let subs = List.map (fun (sc : subcommand) ->
|
||||
|
|
|
|||
|
|
@ -257,7 +257,15 @@ let help_parser =
|
|||
in
|
||||
many (choice [ try_entry; try_subcommand; try_skip ]) >>| fun items ->
|
||||
let entries = List.filter_map (function `Entry e -> Some e | _ -> None) items in
|
||||
let subcommands = List.filter_map (function `Subcommand sc -> Some sc | _ -> None) items in
|
||||
let subcommands =
|
||||
List.filter_map (function `Subcommand sc -> Some sc | _ -> None) items
|
||||
|> List.fold_left (fun acc sc ->
|
||||
match List.assoc_opt sc.name acc with
|
||||
| Some prev when String.length prev.desc >= String.length sc.desc -> acc
|
||||
| _ -> (sc.name, sc) :: List.remove_assoc sc.name acc
|
||||
) []
|
||||
|> List.rev_map snd
|
||||
in
|
||||
{ entries; subcommands; positionals = [] })
|
||||
|
||||
let skip_command_prefix s =
|
||||
|
|
@ -390,10 +398,12 @@ let parse_usage_args s =
|
|||
| _ ->
|
||||
incr i
|
||||
done;
|
||||
let seen = Hashtbl.create 8 in
|
||||
List.rev !results |> List.filter (fun p ->
|
||||
if Hashtbl.mem seen p.pos_name then false
|
||||
else (Hashtbl.replace seen p.pos_name true; true))
|
||||
List.rev !results
|
||||
|> 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
|
||||
|
||||
let extract_usage_positionals text =
|
||||
let lines = String.split_on_char '\n' text in
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue