(* 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