77 lines
2.4 KiB
OCaml
77 lines
2.4 KiB
OCaml
(* open Angstrom_unix *)
|
|
(* also look for "subcommands" for clapslop *)
|
|
(* and other common help patterns *)
|
|
open Angstrom
|
|
|
|
let ( <| ) = ( @@ )
|
|
let ( <&> ) p1 p2 = lift2 (fun a b -> (a, b)) p1 p2
|
|
let is_whitespace = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false
|
|
|
|
let is_alphanumeric = function
|
|
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' -> true
|
|
| _ -> false
|
|
|
|
let is_long_char = function
|
|
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '-' -> true
|
|
| _ -> false
|
|
|
|
type switch = Short of char | Long of string | Both of char * string
|
|
type param = Mandatory of string | Optional of string
|
|
type entry = { switch : switch; param : param option; desc : string }
|
|
|
|
let whitespace = skip_while is_whitespace
|
|
let comma = char ',' *> whitespace
|
|
let short_switch = char '-' *> satisfy is_alphanumeric
|
|
let long_switch = string "--" *> take_while1 is_long_char
|
|
|
|
let opt_param =
|
|
print_endline "opt param is running";
|
|
string "[=" *> take_while is_alphanumeric <* char ']' >>| fun a -> Optional a
|
|
|
|
let man_param =
|
|
print_endline "man param is running";
|
|
char '=' *> take_while is_alphanumeric >>| fun a -> Mandatory a
|
|
|
|
let param_parser =
|
|
option None (choice [ opt_param; man_param ] >>| fun a -> Some a)
|
|
|
|
let switch_parser =
|
|
choice
|
|
[
|
|
(* -a, --all *)
|
|
( short_switch >>= fun s ->
|
|
comma *> long_switch >>| fun l -> Both (s, l) );
|
|
(* -a *)
|
|
(short_switch >>| fun s -> Short s);
|
|
(* --all *)
|
|
(long_switch >>| fun l -> Long l);
|
|
]
|
|
|
|
let description = whitespace *> take_till (fun c -> c = '\n') <* end_of_line
|
|
|
|
let entry =
|
|
skip_while (fun c -> c <> '-')
|
|
*> lift3 (fun a b c -> (a, b, c)) switch_parser param_parser description
|
|
>>| fun (switch, param, desc) -> { switch; param; desc }
|
|
|
|
let endline = option () (char '\n' *> return ())
|
|
let entry_line = entry <* endline
|
|
let help_parser = many entry_line
|
|
|
|
let parse_help txt =
|
|
Angstrom.parse_string ~consume:Consume.Prefix help_parser txt
|
|
|
|
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
|