1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804
|
(** Simple, portable CLI library - Clean implementation *)
open Compat
(* ===== Type Definitions ===== *)
type arg_value =
| VBool of bool
| VString of string
| VInt of int
| VStrings of string list
type context = {
command_name : string;
values : (string, arg_value) Hashtbl.t;
positionals : string list;
}
type arg_spec = {
arg_name : string;
arg_short : char option;
arg_env : string option;
arg_kind :
[ `Flag
| `String of string option * string (* default, placeholder *)
| `Int of int option * string
| `Bool of bool option * string (* default, placeholder *)
| `Strings of string
| `Positional of string
| `Positionals of string
];
arg_doc : string;
}
type command_run = context -> unit
type command = {
cmd_name : string;
cmd_doc : string;
cmd_description : string option;
cmd_args : arg_spec list;
cmd_run : command_run option;
cmd_subcommands : command list;
}
type app = {
app_name : string;
app_version : string;
app_doc : string;
app_description : string option;
app_global_args : arg_spec list;
app_on_global_args : (context -> unit) option;
app_commands : command list;
}
(* ===== Exceptions and Global State ===== *)
exception Parse_error of string
exception Validation_error of string
let exit_code_ref = ref 0
let set_exit_code code = exit_code_ref := code
(* ===== Context Accessors ===== *)
let get_flag ctx name =
try
match Hashtbl.find ctx.values name with
| VBool b -> b
| _ -> false
with Not_found -> false
let get_string_opt ctx name =
try
match Hashtbl.find ctx.values name with
| VString s -> Some s
| _ -> None
with Not_found -> None
let get_string ctx name ~default =
match get_string_opt ctx name with
| Some s -> s
| None -> default
let get_int_opt ctx name =
try
match Hashtbl.find ctx.values name with
| VInt i -> Some i
| _ -> None
with Not_found -> None
let get_int ctx name ~default =
match get_int_opt ctx name with
| Some i -> i
| None -> default
let get_bool_opt ctx name =
try
match Hashtbl.find ctx.values name with
| VBool b -> Some b
| _ -> None
with Not_found -> None
let get_bool ctx name ~default =
match get_bool_opt ctx name with
| Some b -> b
| None -> default
let get_strings ctx name =
try
match Hashtbl.find ctx.values name with
| VStrings l -> l
| VString s -> [ s ]
| _ -> []
with Not_found -> []
let get_positionals ctx = ctx.positionals
let get_command_name ctx = ctx.command_name
(* ===== Command Construction (Functional Builders) ===== *)
let command name ~doc ?description ?(args = []) ~run () =
let base_cmd =
{
cmd_name = name;
cmd_doc = doc;
cmd_description = description;
cmd_args = [];
cmd_run = Some run;
cmd_subcommands = [];
}
in
List.fold_left (fun cmd f -> f cmd) base_cmd args
let command_with_subcommands name ~doc ?description ~commands =
{
cmd_name = name;
cmd_doc = doc;
cmd_description = description;
cmd_args = [];
cmd_run = None;
cmd_subcommands = commands;
}
let app name ~version ~doc ?description ?(global_args = []) ?on_global_args ~commands () =
(* Create a temporary command to collect global args *)
let temp_cmd =
{
cmd_name = "";
cmd_doc = "";
cmd_description = None;
cmd_args = [];
cmd_run = None;
cmd_subcommands = [];
}
in
let with_args = List.fold_left (fun cmd f -> f cmd) temp_cmd global_args in
{
app_name = name;
app_version = version;
app_doc = doc;
app_description = description;
app_global_args = with_args.cmd_args;
app_on_global_args = on_global_args;
app_commands = commands;
}
(* ===== Argument Builders (Return modified command) ===== *)
let add_arg spec cmd = { cmd with cmd_args = spec :: cmd.cmd_args }
let flag name ?short ?env ~doc cmd =
add_arg { arg_name = name; arg_short = short; arg_env = env; arg_kind = `Flag; arg_doc = doc } cmd
let option_string name ?short ?env ?default ?placeholder ~doc cmd =
let ph =
match placeholder with
| Some p -> p
| None -> "STRING"
in
add_arg
{
arg_name = name;
arg_short = short;
arg_env = env;
arg_kind = `String (default, ph);
arg_doc = doc;
}
cmd
let option_int name ?short ?env ?default ?placeholder ~doc cmd =
let ph =
match placeholder with
| Some p -> p
| None -> "INT"
in
add_arg
{
arg_name = name;
arg_short = short;
arg_env = env;
arg_kind = `Int (default, ph);
arg_doc = doc;
}
cmd
let option_bool name ?short ?env ?default ?placeholder ~doc cmd =
let ph =
match placeholder with
| Some p -> p
| None -> "true|false"
in
add_arg
{
arg_name = name;
arg_short = short;
arg_env = env;
arg_kind = `Bool (default, ph);
arg_doc = doc;
}
cmd
let option_strings name ?short ?env ?placeholder ~doc cmd =
let ph =
match placeholder with
| Some p -> p
| None -> "STRING"
in
add_arg
{ arg_name = name; arg_short = short; arg_env = env; arg_kind = `Strings ph; arg_doc = doc }
cmd
let positional name ?placeholder ~doc cmd =
let ph =
match placeholder with
| Some p -> p
| None -> string_uppercase name
in
add_arg
{ arg_name = name; arg_short = None; arg_env = None; arg_kind = `Positional ph; arg_doc = doc }
cmd
let positionals name ?placeholder ~doc cmd =
let ph =
match placeholder with
| Some p -> p
| None -> string_uppercase name
in
add_arg
{ arg_name = name; arg_short = None; arg_env = None; arg_kind = `Positionals ph; arg_doc = doc }
cmd
(* ===== Standard Flags ===== *)
let version_flag cmd = flag "version" ~doc:"Show version information" cmd
let help_flag cmd = flag "help" ~short:'h' ~doc:"Show this help message" cmd
let verbose_flag cmd = flag "verbose" ~short:'v' ~doc:"Verbose output" cmd
let quiet_flag cmd = flag "quiet" ~short:'q' ~doc:"Quiet mode (errors only)" cmd
(* ===== Error Formatting ===== *)
let format_error msg = Printf.sprintf "\027[1;31mError:\027[0m %s" msg
let format_suggestion similar =
if similar = [] then
""
else
"\n\n\027[1mDid you mean:\027[0m\n " ^ String.concat "\n " similar
(* ===== String Utilities ===== *)
let levenshtein_distance s1 s2 =
let m = String.length s1 and n = String.length s2 in
if m = 0 then
n
else if n = 0 then
m
else
let d = Array.make_matrix (m + 1) (n + 1) 0 in
for i = 0 to m do
d.(i).(0) <- i
done;
for j = 0 to n do
d.(0).(j) <- j
done;
for j = 1 to n do
for i = 1 to m do
let cost = if s1.[i - 1] = s2.[j - 1] then 0 else 1 in
d.(i).(j) <- min (min (d.(i - 1).(j) + 1) (d.(i).(j - 1) + 1)) (d.(i - 1).(j - 1) + cost)
done
done;
d.(m).(n)
let suggest_similar candidates target =
let scored = List.map (fun c -> (c, levenshtein_distance c target)) candidates in
let sorted = List.sort (fun (_, d1) (_, d2) -> compare d1 d2) scored in
let threshold = max 3 (String.length target / 2) in
let rec take n = function
| [] -> []
| x :: xs -> if n <= 0 then [] else x :: take (n - 1) xs
in
take 5 (List.map fst (List.filter (fun (_, d) -> d <= threshold) sorted))
let suggest_command app name =
suggest_similar (List.map (fun c -> c.cmd_name) app.app_commands) name
(* ===== Configuration File Support ===== *)
type config = (string, string) Hashtbl.t
let parse_config_line line =
(* Skip comments and empty lines *)
let trimmed = String_utils.strip_spaces line in
if String.length trimmed = 0 || trimmed.[0] = '#' then
None
else
try
let eq_pos = String.index trimmed '=' in
let key = String_utils.strip_spaces (String.sub trimmed 0 eq_pos) in
let value =
String_utils.strip_spaces (String.sub trimmed (eq_pos + 1) (String.length trimmed - eq_pos - 1))
in
Some (key, value)
with Not_found -> None
let load_config_file path =
let config = Hashtbl.create 16 in
if Sys.file_exists path then
try
let ic = open_in path in
try
while true do
let line = input_line ic in
match parse_config_line line with
| Some (key, value) -> Hashtbl.replace config key value
| None -> ()
done;
config
with End_of_file ->
close_in ic;
config
with Sys_error _ -> config
else
config
let load_config ?(paths = []) () =
let default_paths =
if paths = [] then
let home = try Sys.getenv "HOME" with Not_found -> "" in
let user_config = if home <> "" then [ Filename.concat home ".obuildrc" ] else [] in
let project_config = [ ".obuildrc" ] in
user_config @ project_config
else
paths
in
let config = Hashtbl.create 16 in
List.iter
(fun path ->
let file_config = load_config_file path in
Hashtbl.iter (fun k v -> Hashtbl.replace config k v) file_config)
default_paths;
config
let config_get_string config key = try Some (Hashtbl.find config key) with Not_found -> None
let config_get_int config key =
try Some (int_of_string (Hashtbl.find config key)) with Not_found | Failure _ -> None
let config_get_bool config key =
try
let value = string_lowercase (Hashtbl.find config key) in
match value with
| "true" | "yes" | "1" | "on" -> Some true
| "false" | "no" | "0" | "off" -> Some false
| _ -> None
with Not_found -> None
(* ===== Shell Completion Generation ===== *)
let generate_bash_completion app =
let commands = String.concat " " (List.map (fun c -> c.cmd_name) app.app_commands) in
Printf.sprintf
"# Bash completion for %s\n\
_%s_completions() {\n\
\ local cur prev\n\
\ COMPREPLY=()\n\
\ cur=\"${COMP_WORDS[COMP_CWORD]}\"\n\
\ prev=\"${COMP_WORDS[COMP_CWORD-1]}\"\n\
\n\
\ # Complete commands\n\
\ if [ $COMP_CWORD -eq 1 ]; then\n\
\ COMPREPLY=( $(compgen -W \"%s\" -- \"$cur\") )\n\
\ return 0\n\
\ fi\n\
\n\
\ # Complete global flags\n\
\ local flags=\"--help --version --verbose --quiet --debug --color\"\n\
\ COMPREPLY=( $(compgen -W \"$flags\" -- \"$cur\") )\n\
\ return 0\n\
}\n\
\n\
complete -F _%s_completions %s\n"
app.app_name app.app_name commands app.app_name app.app_name
let generate_zsh_completion app =
let cmd_list =
String.concat "\n "
(List.map (fun c -> Printf.sprintf "'%s:%s'" c.cmd_name c.cmd_doc) app.app_commands)
in
Printf.sprintf
"#compdef %s\n\
\n\
_%s() {\n\
\ local -a commands\n\
\ commands=(\n\
\ %s\n\
\ )\n\
\n\
\ _arguments -C \\\n\
\ '(- 1 *)'{-h,--help}'[Show help message]' \\\n\
\ '(- 1 *)--version[Show version information]' \\\n\
\ {-v,--verbose}'[Verbose output]' \\\n\
\ {-q,--quiet}'[Quiet mode]' \\\n\
\ '--color[Enable colored output]' \\\n\
\ '1: :->cmds' \\\n\
\ '*:: :->args' && return 0\n\
\n\
\ case \"$state\" in\n\
\ cmds)\n\
\ _describe -t commands 'command' commands\n\
\ ;;\n\
\ esac\n\
}\n\
\n\
_%s \"$@\"\n"
app.app_name app.app_name cmd_list app.app_name
let generate_fish_completion app =
let completions =
String.concat "\n"
(List.map
(fun c ->
Printf.sprintf "complete -c %s -n '__fish_use_subcommand' -a %s -d '%s'" app.app_name
c.cmd_name c.cmd_doc)
app.app_commands)
in
Printf.sprintf
"# Fish completion for %s\n\
\n\
# Global options\n\
complete -c %s -s h -l help -d 'Show help message'\n\
complete -c %s -l version -d 'Show version information'\n\
complete -c %s -s v -l verbose -d 'Verbose output'\n\
complete -c %s -s q -l quiet -d 'Quiet mode'\n\
complete -c %s -l color -d 'Enable colored output'\n\
\n\
# Commands\n\
%s\n"
app.app_name app.app_name app.app_name app.app_name app.app_name app.app_name completions
(* ===== Help Generation ===== *)
let print_usage_line chan app_name cmd_name =
Printf.fprintf chan "Usage: %s" app_name;
(match cmd_name with
| Some n -> Printf.fprintf chan " %s" n
| None -> ());
Printf.fprintf chan " [OPTIONS]";
Printf.fprintf chan "\n"
let print_arg_help chan spec =
let short_str =
match spec.arg_short with
| Some c -> Printf.sprintf "-%c, " c
| None -> " "
in
let long_name = "--" ^ spec.arg_name in
let placeholder =
match spec.arg_kind with
| `String (_, ph) | `Int (_, ph) | `Bool (_, ph) | `Strings ph | `Positional ph | `Positionals ph -> " " ^ ph
| `Flag -> ""
in
Printf.fprintf chan " %s%s%s\n" short_str long_name placeholder;
Printf.fprintf chan " %s\n" spec.arg_doc
let print_help app cmd_opt =
let chan = stdout in
(match cmd_opt with
| None ->
Printf.fprintf chan "%s - %s\n" app.app_name app.app_doc;
Printf.fprintf chan "Version: %s\n\n" app.app_version;
(match app.app_description with
| Some d -> Printf.fprintf chan "%s\n\n" d
| None -> ());
print_usage_line chan app.app_name None;
if app.app_global_args <> [] then (
Printf.fprintf chan "\nGlobal Options:\n";
List.iter (print_arg_help chan) (List.rev app.app_global_args));
Printf.fprintf chan "\nCommands:\n";
List.iter
(fun cmd -> Printf.fprintf chan " %-20s %s\n" cmd.cmd_name cmd.cmd_doc)
app.app_commands;
Printf.fprintf chan "\nRun '%s COMMAND -h' for command-specific help.\n" app.app_name
| Some cmd ->
Printf.fprintf chan "%s %s - %s\n\n" app.app_name cmd.cmd_name cmd.cmd_doc;
(match cmd.cmd_description with
| Some d -> Printf.fprintf chan "%s\n\n" d
| None -> ());
print_usage_line chan app.app_name (Some cmd.cmd_name);
if cmd.cmd_args <> [] then (
Printf.fprintf chan "\nOptions:\n";
List.iter (print_arg_help chan) (List.rev cmd.cmd_args));
if cmd.cmd_subcommands <> [] then (
Printf.fprintf chan "\nSubcommands:\n";
List.iter
(fun subcmd -> Printf.fprintf chan " %-20s %s\n" subcmd.cmd_name subcmd.cmd_doc)
cmd.cmd_subcommands));
flush chan
(* ===== Argument Parsing ===== *)
let parse_args ?(stop_at_positional = false) specs argv start_idx =
let values = Hashtbl.create 16 in
let positionals = ref [] in
let idx = ref start_idx in
let len = Array.length argv in
let stopped = ref false in
(* Initialize defaults and env vars *)
List.iter
(fun spec ->
match spec.arg_kind with
| `String (Some def, _) -> Hashtbl.add values spec.arg_name (VString def)
| `Int (Some def, _) -> Hashtbl.add values spec.arg_name (VInt def)
| `Bool (Some def, _) -> Hashtbl.add values spec.arg_name (VBool def)
| `Flag -> Hashtbl.add values spec.arg_name (VBool false)
| _ -> ())
specs;
while !idx < len && not !stopped do
let arg = argv.(!idx) in
if String.length arg > 0 && arg.[0] = '-' then (* Parse option *)
let is_long = String.length arg > 1 && arg.[1] = '-' in
let opt_name, opt_val =
if is_long then (* Long option: --name or --name=value *)
let name_part = String.sub arg 2 (String.length arg - 2) in
try
let eq_pos = String.index name_part '=' in
( String.sub name_part 0 eq_pos,
Some (String.sub name_part (eq_pos + 1) (String.length name_part - eq_pos - 1)) )
with Not_found -> (name_part, None)
else if
(* Short option: -n or -nvalue *)
String.length arg < 2
then
raise (Parse_error "Invalid option")
else
( String.make 1 arg.[1],
if String.length arg > 2 then Some (String.sub arg 2 (String.length arg - 2)) else None
)
in
(* Find matching spec *)
let spec_opt =
SafeList.find_opt
(fun s ->
if is_long then
s.arg_name = opt_name
else
match
s.arg_short
with
| Some c -> String.make 1 c = opt_name
| None -> false)
specs
in
match spec_opt with
| None -> raise (Parse_error ("Unknown option: " ^ arg))
| Some spec -> (
match spec.arg_kind with
| `Flag ->
Hashtbl.replace values spec.arg_name (VBool true);
incr idx
| `String _ | `Int _ | `Bool _ ->
let value =
match opt_val with
| Some v -> v
| None ->
incr idx;
if !idx >= len then raise (Parse_error (spec.arg_name ^ " requires a value"));
argv.(!idx)
in
(match spec.arg_kind with
| `String _ -> Hashtbl.replace values spec.arg_name (VString value)
| `Int _ -> (
try Hashtbl.replace values spec.arg_name (VInt (int_of_string value))
with Failure _ -> raise (Parse_error (spec.arg_name ^ " requires an integer")))
| `Bool _ -> (
try
let bool_val = match string_lowercase value with
| "true" | "yes" | "1" | "on" -> true
| "false" | "no" | "0" | "off" -> false
| _ -> raise (Parse_error (spec.arg_name ^ " requires true/false/yes/no/1/0"))
in
Hashtbl.replace values spec.arg_name (VBool bool_val)
with Failure _ -> raise (Parse_error (spec.arg_name ^ " requires a boolean value")))
| _ -> ());
incr idx
| `Strings _ ->
let value =
match opt_val with
| Some v -> v
| None ->
incr idx;
if !idx >= len then raise (Parse_error (spec.arg_name ^ " requires a value"));
argv.(!idx)
in
let existing =
try
match Hashtbl.find values spec.arg_name with
| VStrings l -> l
| _ -> []
with Not_found -> []
in
Hashtbl.replace values spec.arg_name (VStrings (existing @ [ value ]));
incr idx
| _ -> incr idx)
else (
(* Positional argument *)
positionals := !positionals @ [ arg ];
incr idx;
if stop_at_positional then stopped := true)
done;
(* Collect remaining args if we stopped early *)
let remaining = ref [] in
while !idx < len do
remaining := !remaining @ [ argv.(!idx) ];
incr idx
done;
(values, List.rev !positionals @ !remaining)
(* ===== Main Execution ===== *)
let run_internal argv app =
if Array.length argv < 2 then (
print_help app None;
raise (Parse_error "No command specified"));
(* Parse global args - stop at first positional (command name) *)
let global_vals, remaining = parse_args ~stop_at_positional:true app.app_global_args argv 1 in
(* Check for global --help or --version *)
(try
let global_ctx = { command_name = ""; values = global_vals; positionals = [] } in
if get_flag global_ctx "help" then (
print_help app None;
exit 0);
if get_flag global_ctx "version" then (
Printf.printf "%s %s\n" app.app_name app.app_version;
exit 0)
with Not_found -> ());
(* Invoke global args callback if provided *)
(match app.app_on_global_args with
| Some f -> f { command_name = ""; values = global_vals; positionals = [] }
| None -> ());
match remaining with
| [] ->
print_help app None;
raise (Parse_error "No command specified")
| cmd_name :: cmd_args ->
(* Find command *)
let cmd_opt = SafeList.find_opt (fun c -> c.cmd_name = cmd_name) app.app_commands in
match cmd_opt with
| None ->
let suggestions = suggest_command app cmd_name in
let msg = Printf.sprintf "Unknown command '%s'" cmd_name in
let msg = msg ^ format_suggestion suggestions in
raise (Parse_error msg)
| Some cmd -> (
(* Parse command args *)
let cmd_vals, cmd_positionals = parse_args cmd.cmd_args (Array.of_list cmd_args) 0 in
let ctx = { command_name = cmd.cmd_name; values = cmd_vals; positionals = cmd_positionals } in
(* Check for command --help *)
if get_flag ctx "help" then (
print_help app (Some cmd);
exit 0);
(* Run command or route to subcommand *)
match cmd.cmd_run with
| Some run -> run ctx
| None ->
if cmd.cmd_subcommands = [] then
raise (Parse_error "Command has no implementation")
else (
(* Handle subcommands *)
match cmd_positionals with
| [] ->
print_help app (Some cmd);
raise (Parse_error "Subcommand required")
| subcmd_name :: subcmd_args ->
(* Find subcommand *)
let subcmd_opt =
SafeList.find_opt (fun c -> c.cmd_name = subcmd_name) cmd.cmd_subcommands
in
match subcmd_opt with
| None ->
let msg = Printf.sprintf "Unknown subcommand '%s'" subcmd_name in
raise (Parse_error msg)
| Some subcmd -> (
(* Parse subcommand args *)
let subcmd_vals, subcmd_positionals =
parse_args subcmd.cmd_args (Array.of_list subcmd_args) 0
in
let subcmd_ctx =
{
command_name = subcmd.cmd_name;
values = subcmd_vals;
positionals = subcmd_positionals;
}
in
(* Check for subcommand --help *)
if get_flag subcmd_ctx "help" then (
(* TODO: print subcommand help - for now just print command help *)
print_help app (Some subcmd);
exit 0);
(* Run subcommand *)
match subcmd.cmd_run with
| Some run -> run subcmd_ctx
| None -> raise (Parse_error "Subcommand has no implementation"))))
let run ?(argv = Sys.argv) app =
try
run_internal argv app;
exit !exit_code_ref
with
| Parse_error msg ->
Printf.eprintf "%s\n" (format_error msg);
exit 1
| Validation_error msg ->
Printf.eprintf "%s\n" (format_error ("Validation failed: " ^ msg));
exit 1
| Failure msg ->
Printf.eprintf "%s\n" (format_error msg);
exit 1
let run_result ?(argv = Sys.argv) app =
try
run_internal argv app;
Ok ()
with
| Parse_error msg -> Error ("Parse error: " ^ msg)
| Validation_error msg -> Error ("Validation error: " ^ msg)
| Failure msg -> Error msg
| exn -> Error (Printexc.to_string exn)
(* Apply config defaults to argument specs *)
let apply_config_to_specs config specs =
List.map
(fun spec ->
match spec.arg_kind with
| `String (_, ph) -> (
match config_get_string config spec.arg_name with
| Some value -> { spec with arg_kind = `String (Some value, ph) }
| None -> spec)
| `Int (_, ph) -> (
match config_get_int config spec.arg_name with
| Some value -> { spec with arg_kind = `Int (Some value, ph) }
| None -> spec)
| `Bool (_, ph) -> (
match config_get_bool config spec.arg_name with
| Some value -> { spec with arg_kind = `Bool (Some value, ph) }
| None -> spec)
| `Flag -> (
match config_get_bool config spec.arg_name with
| Some true ->
spec
(* Can't set flag default to true in current system, would need VBool in hashtable *)
| _ -> spec)
| _ -> spec)
specs
let run_with_config ?(argv = Sys.argv) ?config app =
let app_with_config =
match config with
| None -> app
| Some cfg ->
(* Apply config to global args and all command args *)
let new_global_args = apply_config_to_specs cfg app.app_global_args in
let new_commands =
List.map
(fun cmd -> { cmd with cmd_args = apply_config_to_specs cfg cmd.cmd_args })
app.app_commands
in
{ app with app_global_args = new_global_args; app_commands = new_commands }
in
run ~argv app_with_config
|