From ea5cf6f377c05b8129b7484b2f6a61355f65ad36 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:13:51 +0100 Subject: [PATCH 1/7] Update spell config --- .vscode/settings.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index ce84d3c..4f8c029 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -3,10 +3,11 @@ "cmdlang", "cmdliner", "conv", + "groff", "janestreet", "odoc", "opam", "stdune", "stringable" ] -} +} \ No newline at end of file From bf62f0fff1c1385961c0a11d00cbdf0e564f8b44 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:17:58 +0100 Subject: [PATCH 2/7] Add Ast utils --- lib/cmdlang_ast/src/ast.ml | 8 +++++++- lib/cmdlang_ast/src/ast.mli | 5 ++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/lib/cmdlang_ast/src/ast.ml b/lib/cmdlang_ast/src/ast.ml index 6ea6fdb..9304303 100644 --- a/lib/cmdlang_ast/src/ast.ml +++ b/lib/cmdlang_ast/src/ast.ml @@ -1,4 +1,5 @@ -type 'a parse = string -> ('a, [ `Msg of string ]) result +type 'a or_error_msg = ('a, [ `Msg of string ]) result +type 'a parse = string -> 'a or_error_msg type 'a print = Format.formatter -> 'a -> unit module Nonempty_list = struct @@ -124,4 +125,9 @@ module Command = struct ; subcommands : (string * 'a t) list } -> 'a t + + let summary = function + | Make { summary; _ } -> summary + | Group { summary; _ } -> summary + ;; end diff --git a/lib/cmdlang_ast/src/ast.mli b/lib/cmdlang_ast/src/ast.mli index 3345e56..c57b628 100644 --- a/lib/cmdlang_ast/src/ast.mli +++ b/lib/cmdlang_ast/src/ast.mli @@ -15,7 +15,8 @@ [Cmdlang_ast] is exposed to allow extending the library with new backends or to write analysis tools, etc. *) -type 'a parse := string -> ('a, [ `Msg of string ]) result +type 'a or_error_msg = ('a, [ `Msg of string ]) result +type 'a parse := string -> 'a or_error_msg type 'a print := Format.formatter -> 'a -> unit module Nonempty_list : sig @@ -141,4 +142,6 @@ module Command : sig ; subcommands : (string * 'a t) list } -> 'a t + + val summary : _ t -> string end From 62459b2d46373d9875f241e258d8391bdddeff7b Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:20:46 +0100 Subject: [PATCH 3/7] Simplify calls to exit --- doc/docs/tutorials/getting-started/README.md | 2 +- doc/docs/tutorials/getting-started/bin/main.ml | 2 +- test/cram/bin/cmdliner/main_cmdliner.ml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/docs/tutorials/getting-started/README.md b/doc/docs/tutorials/getting-started/README.md index 4b6ecbb..e68ecc6 100644 --- a/doc/docs/tutorials/getting-started/README.md +++ b/doc/docs/tutorials/getting-started/README.md @@ -103,7 +103,7 @@ let () = Getting_started.cmd ~name:"my-calculator" ~version:"%%VERSION%%") - |> Stdlib.exit + |> exit ;; ``` diff --git a/doc/docs/tutorials/getting-started/bin/main.ml b/doc/docs/tutorials/getting-started/bin/main.ml index e9aaf8f..61b13ab 100644 --- a/doc/docs/tutorials/getting-started/bin/main.ml +++ b/doc/docs/tutorials/getting-started/bin/main.ml @@ -4,5 +4,5 @@ let () = Getting_started.cmd ~name:"my-calculator" ~version:"%%VERSION%%") - |> Stdlib.exit + |> exit ;; diff --git a/test/cram/bin/cmdliner/main_cmdliner.ml b/test/cram/bin/cmdliner/main_cmdliner.ml index d312ee7..31923f3 100644 --- a/test/cram/bin/cmdliner/main_cmdliner.ml +++ b/test/cram/bin/cmdliner/main_cmdliner.ml @@ -4,5 +4,5 @@ let () = Cram_test_command.Cmd.main ~name:Sys.argv.(0) ~version:"%%VERSION%%") - |> Stdlib.exit + |> exit ;; From 6ce6ee1c7f694b1ff724a5b4896df84b60b51dc4 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:16:51 +0100 Subject: [PATCH 4/7] Remove Param.assoc --- lib/cmdlang/src/command.ml | 10 +++------- lib/cmdlang/src/command.mli | 8 +++++++- lib/cmdlang/test/test__command.ml | 17 +++++++++++++--- lib/cmdlang_ast/src/ast.ml | 1 + lib/cmdlang_ast/src/ast.mli | 1 + lib/cmdlang_to_base/src/translate.ml | 2 +- lib/cmdlang_to_climate/src/translate.ml | 25 ++++++------------------ lib/cmdlang_to_cmdliner/src/translate.ml | 6 +++--- 8 files changed, 36 insertions(+), 34 deletions(-) diff --git a/lib/cmdlang/src/command.ml b/lib/cmdlang/src/command.ml index 85f7a19..fbef72c 100644 --- a/lib/cmdlang/src/command.ml +++ b/lib/cmdlang/src/command.ml @@ -38,14 +38,10 @@ module Param = struct let bool = Ast.Param.Bool let file = Ast.Param.File - let assoc ?docv choices = - match choices with - | [] -> invalid_arg "Command.Param.assoc" - | hd :: tl -> Ast.Param.Enum { docv; choices = hd :: tl } - ;; - let enumerated (type a) ?docv (module M : Enumerated_stringable with type t = a) = - assoc ?docv (M.all |> List.map (fun m -> M.to_string m, m)) + match M.all |> List.map (fun m -> M.to_string m, m) with + | [] -> invalid_arg "Command.Param.enumerated" + | hd :: tl -> Ast.Param.Enum { docv; choices = hd :: tl; to_string = M.to_string } ;; let stringable (type a) ?docv (module M : Stringable with type t = a) = diff --git a/lib/cmdlang/src/command.mli b/lib/cmdlang/src/command.mli index 81f7ec3..723f3fb 100644 --- a/lib/cmdlang/src/command.mli +++ b/lib/cmdlang/src/command.mli @@ -64,6 +64,13 @@ module type Enumerated_stringable = sig type t val all : t list + + (** Due to the canonical string representation contract, cmdlang will assume + to be able to define an equality function between [t]s defined as such: + + {[ + let equal a b = phys_equal a b || String.equal (to_string a) (to_string b) + ]} *) val to_string : t -> string end @@ -116,7 +123,6 @@ module Param : sig (** {1 Helpers} *) - val assoc : ?docv:string -> (string * 'a) list -> 'a t val enumerated : ?docv:string -> (module Enumerated_stringable with type t = 'a) -> 'a t val stringable : ?docv:string -> (module Stringable with type t = 'a) -> 'a t diff --git a/lib/cmdlang/test/test__command.ml b/lib/cmdlang/test/test__command.ml index d47a7be..8422c4d 100644 --- a/lib/cmdlang/test/test__command.ml +++ b/lib/cmdlang/test/test__command.ml @@ -1,6 +1,17 @@ -let%expect_test "Param.assoc" = +module Empty = struct + type t = | + + let all = [] + + let to_string t = + match[@coverage off] t with + | (_ : t) -> . + ;; +end + +let%expect_test "Param.enumerated" = let open Command.Std in - require_does_raise [%here] (fun () -> Param.assoc []); - [%expect {| (Invalid_argument Command.Param.assoc) |}]; + require_does_raise [%here] (fun () -> Param.enumerated (module Empty)); + [%expect {| (Invalid_argument Command.Param.enumerated) |}]; () ;; diff --git a/lib/cmdlang_ast/src/ast.ml b/lib/cmdlang_ast/src/ast.ml index 9304303..5e01542 100644 --- a/lib/cmdlang_ast/src/ast.ml +++ b/lib/cmdlang_ast/src/ast.ml @@ -22,6 +22,7 @@ module Param = struct | Enum : { docv : string option ; choices : (string * 'a) Nonempty_list.t + ; to_string : 'a -> string } -> 'a t | Comma_separated : 'a t -> 'a list t diff --git a/lib/cmdlang_ast/src/ast.mli b/lib/cmdlang_ast/src/ast.mli index c57b628..8151f9e 100644 --- a/lib/cmdlang_ast/src/ast.mli +++ b/lib/cmdlang_ast/src/ast.mli @@ -39,6 +39,7 @@ module Param : sig | Enum : { docv : string option ; choices : (string * 'a) Nonempty_list.t + ; to_string : 'a -> string } -> 'a t | Comma_separated : 'a t -> 'a list t diff --git a/lib/cmdlang_to_base/src/translate.ml b/lib/cmdlang_to_base/src/translate.ml index 686918f..1034dbc 100644 --- a/lib/cmdlang_to_base/src/translate.ml +++ b/lib/cmdlang_to_base/src/translate.ml @@ -56,7 +56,7 @@ module Param = struct | Float -> Some "FLOAT" | Bool -> Some "BOOL" | File -> Some "FILE" - | Enum { docv; choices = _ } -> docv + | Enum { docv; choices = _; to_string = _ } -> docv | Comma_separated param -> docv param |> Option.map ~f:(fun docv -> Printf.sprintf "[%s,..]" docv) ;; diff --git a/lib/cmdlang_to_climate/src/translate.ml b/lib/cmdlang_to_climate/src/translate.ml index fe4ee86..adcf99d 100644 --- a/lib/cmdlang_to_climate/src/translate.ml +++ b/lib/cmdlang_to_climate/src/translate.ml @@ -11,27 +11,14 @@ module Param = struct | Float -> Climate.Arg_parser.float | Bool -> Climate.Arg_parser.bool | File -> Climate.Arg_parser.file - | Enum { docv; choices = hd :: tl } -> + | Enum { docv; choices = hd :: tl; to_string } -> let choices = hd :: tl in - let eq a b = - (* We are basing this function on the fact that climate cannot produce - values of type ['a] out of thin air, rather the values that are going - to be supplied to [eq] necessarily come from [choices]. Thus we can - base the equality function from that of the attached string - mnemonics (alternatively, this could also be done in climate). *) - if a == b - then true - else ( - match - ( List.find_opt (fun (_, x) -> x == a) choices - , List.find_opt (fun (_, x) -> x == b) choices ) - with - | Some (a, _), Some (b, _) -> String.equal a b - | Some _, None | None, Some _ | None, None -> - raise - (Invalid_argument "Cmdlang_to_climate.enum: eq called with unknown choice") - [@coverage off]) + let str x = + match List.find_opt (fun (_, y) -> y == x) choices with + | Some (a, _) -> a + | None -> to_string x in + let eq a b = a == b || String.equal (str a) (str b) in Climate.Arg_parser.enum ?default_value_name:docv choices ~eq | Comma_separated t -> let { Climate.Arg_parser.parse; print; default_value_name; completion = _ } = diff --git a/lib/cmdlang_to_cmdliner/src/translate.ml b/lib/cmdlang_to_cmdliner/src/translate.ml index b1a70d9..fb97956 100644 --- a/lib/cmdlang_to_cmdliner/src/translate.ml +++ b/lib/cmdlang_to_cmdliner/src/translate.ml @@ -6,7 +6,7 @@ module Param = struct | Float -> Cmdliner.Arg.float | Bool -> Cmdliner.Arg.bool | File -> Cmdliner.Arg.file - | Enum { docv = _; choices = hd :: tl } -> Cmdliner.Arg.enum (hd :: tl) + | Enum { docv = _; choices = hd :: tl; to_string = _ } -> Cmdliner.Arg.enum (hd :: tl) | Comma_separated param -> Cmdliner.Arg.list ~sep:',' (translate param) ;; @@ -17,7 +17,7 @@ module Param = struct | Float -> Some "FLOAT" | Bool -> Some "BOOL" | File -> Some "FILE" - | Enum { docv; choices = _ } -> docv + | Enum { docv; choices = _; to_string = _ } -> docv | Comma_separated param -> docv param |> Option.map (fun docv -> Printf.sprintf "[%s,..]" docv) ;; @@ -42,7 +42,7 @@ module Arg = struct fun ~doc ~param -> match (param : _ Ast.Param.t) with | Conv _ | String | Int | Float | Bool | File -> with_dot_suffix ~doc - | Enum { docv = _; choices = hd :: tl } -> + | Enum { docv = _; choices = hd :: tl; to_string = _ } -> Printf.sprintf "%s. $(docv) must be %s." doc From 8206c297a1c8bfb5988c917c31241dbe466a7752 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:19:18 +0100 Subject: [PATCH 5/7] Simplify cmdlang-to-base internal intermediate representations --- lib/cmdlang_to_base/src/translate.ml | 163 ++++++++++++-------------- lib/cmdlang_to_base/src/translate.mli | 2 +- 2 files changed, 76 insertions(+), 89 deletions(-) diff --git a/lib/cmdlang_to_base/src/translate.ml b/lib/cmdlang_to_base/src/translate.ml index 1034dbc..dba9f79 100644 --- a/lib/cmdlang_to_base/src/translate.ml +++ b/lib/cmdlang_to_base/src/translate.ml @@ -20,33 +20,28 @@ module Nonempty_list = struct end module Param = struct - type 'a t = { arg_type : 'a Command.Arg_type.t } + type 'a t = 'a Command.Arg_type.t let translate : type a. a Ast.Param.t -> config:Config.t -> a t = fun ast ~config:(_ : Config.t) -> - let rec translate : type a. a Ast.Param.t -> a t = function + let rec aux : type a. a Ast.Param.t -> a t = function | Conv { docv = _; parse; print = _ } -> let parse s = match parse s with | Ok ok -> ok | Error (`Msg str) -> Error.raise_s [%sexp Msg (str : string)] in - { arg_type = Command.Arg_type.create parse } - | String -> { arg_type = Command.Arg_type.Export.string } - | Int -> { arg_type = Command.Arg_type.Export.int } - | Float -> { arg_type = Command.Arg_type.Export.float } - | Bool -> { arg_type = Command.Arg_type.Export.bool } - | File -> { arg_type = Command.Arg_type.Export.string } - | Enum { docv; choices = hd :: tl } -> - { arg_type = - Command.Arg_type.of_alist_exn - ~list_values_in_help:(Option.is_none docv) - (hd :: tl) - } - | Comma_separated t -> - { arg_type = Command.Arg_type.comma_separated (t |> translate).arg_type } + Command.Arg_type.create parse + | String -> Command.Arg_type.Export.string + | Int -> Command.Arg_type.Export.int + | Float -> Command.Arg_type.Export.float + | Bool -> Command.Arg_type.Export.bool + | File -> Command.Arg_type.Export.string + | Enum { docv; choices = hd :: tl; to_string = _ } -> + Command.Arg_type.of_alist_exn ~list_values_in_help:(Option.is_none docv) (hd :: tl) + | Comma_separated t -> Command.Arg_type.comma_separated (aux t) in - translate ast + aux ast ;; let rec docv : type a. a Ast.Param.t -> string option = function @@ -63,7 +58,7 @@ module Param = struct end module Arg = struct - type 'a t = { param : 'a Command.Param.t } + type 'a t = 'a Command.Param.t let docv_of_param ~docv ~param = match docv with @@ -104,23 +99,23 @@ module Arg = struct let translate : type a. a Ast.Arg.t -> config:Config.t -> a t = fun ast ~(config : Config.t) -> let last_positional_index = ref (-1) in - let rec translate : type a. a Ast.Arg.t -> a t = function - | Return x -> { param = Command.Param.return x } + let rec aux : type a. a Ast.Arg.t -> a t = function + | Return x -> Command.Param.return x | Map { x; f } -> - let { param = x } = translate x in - { param = Command.Param.map x ~f } + let x = aux x in + Command.Param.map x ~f | Both (a, b) -> - let { param = a } = translate a in - let { param = b } = translate b in - { param = Command.Param.both a b } + let a = aux a in + let b = aux b in + Command.Param.both a b | Apply { f; x } -> - let { param = f } = translate f in - let { param = x } = translate x in - { param = Command.Param.apply f x } + let f = aux f in + let x = aux x in + Command.Param.apply f x | Flag { names; doc } -> let (name :: aliases) = translate_flag_names names ~config in let flag = Command.Flag.no_arg in - { param = Command.Param.flag ~aliases name flag ~doc } + Command.Param.flag ~aliases name flag ~doc | Flag_count { names = hd :: tl; doc } -> raise_s [%sexp @@ -128,69 +123,61 @@ module Arg = struct , { names = (hd :: tl : string list); doc : string }] | Named { names; param; docv; doc } -> let (name :: aliases) = translate_flag_names names ~config in - let { Param.arg_type } = Param.translate param ~config in - { param = - Command.Param.flag - ~aliases - ?full_flag_required:(Option.some_if config.full_flags_required ()) - name - (Command.Flag.required arg_type) - ~doc:(doc_of_param ~docv ~doc ~param) - } + let arg_type = Param.translate param ~config in + Command.Param.flag + ~aliases + ?full_flag_required:(Option.some_if config.full_flags_required ()) + name + (Command.Flag.required arg_type) + ~doc:(doc_of_param ~docv ~doc ~param) | Named_multi { names; param; docv; doc } -> let (name :: aliases) = translate_flag_names names ~config in - let { Param.arg_type } = Param.translate param ~config in - { param = - Command.Param.flag - ~aliases - ?full_flag_required:(Option.some_if config.full_flags_required ()) - name - (Command.Flag.listed arg_type) - ~doc:(doc_of_param ~docv ~doc ~param) - } + let arg_type = Param.translate param ~config in + Command.Param.flag + ~aliases + ?full_flag_required:(Option.some_if config.full_flags_required ()) + name + (Command.Flag.listed arg_type) + ~doc:(doc_of_param ~docv ~doc ~param) | Named_opt { names; param; docv; doc } -> let (name :: aliases) = translate_flag_names names ~config in - let { Param.arg_type } = Param.translate param ~config in - { param = - Command.Param.flag - ~aliases - ?full_flag_required:(Option.some_if config.full_flags_required ()) - name - (Command.Flag.optional arg_type) - ~doc:(doc_of_param ~docv ~doc ~param) - } + let arg_type = Param.translate param ~config in + Command.Param.flag + ~aliases + ?full_flag_required:(Option.some_if config.full_flags_required ()) + name + (Command.Flag.optional arg_type) + ~doc:(doc_of_param ~docv ~doc ~param) | Named_with_default { names; param; default; docv; doc } -> let (name :: aliases) = translate_flag_names names ~config in - let { Param.arg_type } = Param.translate param ~config in - { param = - Command.Param.flag - ~aliases - ?full_flag_required:(Option.some_if config.full_flags_required ()) - name - (Command.Flag.optional_with_default default arg_type) - ~doc:(doc_of_param ~docv ~doc ~param) - } + let arg_type = Param.translate param ~config in + Command.Param.flag + ~aliases + ?full_flag_required:(Option.some_if config.full_flags_required ()) + name + (Command.Flag.optional_with_default default arg_type) + ~doc:(doc_of_param ~docv ~doc ~param) | Pos { pos; param; docv; doc = _ } -> check_positional_index ~last_positional_index ~next_positional_index:pos; - let { Param.arg_type } = Param.translate param ~config in + let arg_type = Param.translate param ~config in let anon = Command.Anons.(docv_of_param ~docv ~param %: arg_type) in - { param = Command.Param.anon anon } + Command.Param.anon anon | Pos_opt { pos; param; docv; doc = _ } -> check_positional_index ~last_positional_index ~next_positional_index:pos; - let { Param.arg_type } = Param.translate param ~config in + let arg_type = Param.translate param ~config in let anon = Command.Anons.(docv_of_param ~docv ~param %: arg_type) in - { param = Command.Param.anon (Command.Anons.maybe anon) } + Command.Param.anon (Command.Anons.maybe anon) | Pos_with_default { pos; param; default; docv; doc = _ } -> check_positional_index ~last_positional_index ~next_positional_index:pos; - let { Param.arg_type } = Param.translate param ~config in + let arg_type = Param.translate param ~config in let anon = Command.Anons.(docv_of_param ~docv ~param %: arg_type) in - { param = Command.Param.anon (Command.Anons.maybe_with_default default anon) } + Command.Param.anon (Command.Anons.maybe_with_default default anon) | Pos_all { param; docv; doc = _ } -> - let { Param.arg_type } = Param.translate param ~config in + let arg_type = Param.translate param ~config in let anon = Command.Anons.(docv_of_param ~docv ~param %: arg_type) in - { param = Command.Param.anon (Command.Anons.sequence anon) } + Command.Param.anon (Command.Anons.sequence anon) in - translate ast + aux ast ;; end @@ -201,11 +188,11 @@ module Command = struct | Some config -> config | None -> Config.create () in - let rec unit : unit Ast.Command.t -> Command.t = + let rec aux : unit Ast.Command.t -> Command.t = fun command -> match command with | Make { arg; summary; readme } -> - let { Arg.param } = arg |> Arg.translate ~config in + let param = arg |> Arg.translate ~config in Command.basic ~summary ?readme @@ -215,9 +202,9 @@ module Command = struct Command.group ~summary ?readme - (List.map subcommands ~f:(fun (name, arg) -> name, arg |> unit)) + (List.map subcommands ~f:(fun (name, arg) -> name, arg |> aux)) in - unit command + aux command ;; let basic ?config command = @@ -226,19 +213,19 @@ module Command = struct | Some config -> config | None -> Config.create () in - let rec basic : (unit -> unit) Ast.Command.t -> Command.t = + let rec aux : (unit -> unit) Ast.Command.t -> Command.t = fun command -> match command with | Make { arg; summary; readme } -> - let { Arg.param } = arg |> Arg.translate ~config in + let param = arg |> Arg.translate ~config in Command.basic ~summary ?readme param | Group { default = _; summary; readme; subcommands } -> Command.group ~summary ?readme - (List.map subcommands ~f:(fun (name, arg) -> name, arg |> basic)) + (List.map subcommands ~f:(fun (name, arg) -> name, arg |> aux)) in - basic command + aux command ;; let or_error ?config command = @@ -247,26 +234,26 @@ module Command = struct | Some config -> config | None -> Config.create () in - let rec or_error : (unit -> unit Or_error.t) Ast.Command.t -> Command.t = + let rec aux : (unit -> unit Or_error.t) Ast.Command.t -> Command.t = fun command -> match command with | Make { arg; summary; readme } -> - let { Arg.param } = arg |> Arg.translate ~config in + let param = arg |> Arg.translate ~config in Command.basic_or_error ~summary ?readme param | Group { default = _; summary; readme; subcommands } -> Command.group ~summary ?readme - (List.map subcommands ~f:(fun (name, arg) -> name, arg |> or_error)) + (List.map subcommands ~f:(fun (name, arg) -> name, arg |> aux)) in - or_error command + aux command ;; end module To_ast = Cmdlang.Command.Private.To_ast -let param p ~config = (p |> To_ast.param |> Param.translate ~config).arg_type -let arg a ~config = (a |> To_ast.arg |> Arg.translate ~config).param +let param p ~config = p |> To_ast.param |> Param.translate ~config +let arg a ~config = a |> To_ast.arg |> Arg.translate ~config let command_unit ?config a = a |> To_ast.command |> Command.unit ?config let command_basic ?config a = a |> To_ast.command |> Command.basic ?config let command_or_error ?config a = a |> To_ast.command |> Command.or_error ?config diff --git a/lib/cmdlang_to_base/src/translate.mli b/lib/cmdlang_to_base/src/translate.mli index fcbef5a..06d2faf 100644 --- a/lib/cmdlang_to_base/src/translate.mli +++ b/lib/cmdlang_to_base/src/translate.mli @@ -55,7 +55,7 @@ module Private : sig change in breaking ways without any notice. Do not use. *) module Arg : sig - type 'a t = { param : 'a Command.Param.t } + type 'a t = 'a Command.Param.t val translate : 'a Cmdlang_ast.Ast.Arg.t -> config:Config.t -> 'a t end From 1eec94ae9246d8614038cdb141a517e3f5fb17e0 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:20:19 +0100 Subject: [PATCH 6/7] Add runner based on stdlib.arg --- cmdlang-stdlib-runner.opam | 30 +++ cmdlang-tests.opam | 1 + dune-project | 11 + lib/cmdlang_stdlib_runner/src/arg_runner.ml | 28 +++ lib/cmdlang_stdlib_runner/src/arg_runner.mli | 20 ++ lib/cmdlang_stdlib_runner/src/arg_state.ml | 190 ++++++++++++++++++ lib/cmdlang_stdlib_runner/src/arg_state.mli | 157 +++++++++++++++ .../src/cmdlang_stdlib_runner.ml | 168 ++++++++++++++++ .../src/cmdlang_stdlib_runner.mli | 21 ++ .../src/command_selector.ml | 22 ++ .../src/command_selector.mli | 26 +++ lib/cmdlang_stdlib_runner/src/dune | 17 ++ lib/cmdlang_stdlib_runner/src/param_parser.ml | 76 +++++++ .../src/param_parser.mli | 22 ++ lib/cmdlang_stdlib_runner/src/parser_state.ml | 146 ++++++++++++++ .../src/parser_state.mli | 30 +++ .../src/positional_state.ml | 125 ++++++++++++ .../src/positional_state.mli | 65 ++++++ lib/cmdlang_stdlib_runner/test/dune | 33 +++ test/cram/basic.t | 144 +++++++++++++ test/cram/bin/stdlib-runner/dune | 7 + .../bin/stdlib-runner/main_stdlib_runner.ml | 1 + test/cram/const.t | 11 + test/cram/doc.t | 50 ++++- test/cram/dune | 6 +- test/cram/main-help.t | 15 ++ test/cram/named-opt.t | 30 +++ test/cram/named-with-default.t | 118 +++++++++++ test/cram/src/cmd.ml | 21 +- test/expect/arg_test.ml | 20 +- test/expect/dune | 1 + test/expect/test__applicative_operations.ml | 12 ++ test/expect/test__cmd_name_with_underscore.ml | 11 + test/expect/test__flag.ml | 102 +++++++++- test/expect/test__invalid_pos_opt.ml | 25 +++ test/expect/test__named.ml | 76 ++++++- test/expect/test__negative_int_args.ml | 28 ++- test/expect/test__param.ml | 177 +++++++++++----- test/expect/test__pos.ml | 37 ++++ 39 files changed, 2010 insertions(+), 70 deletions(-) create mode 100644 cmdlang-stdlib-runner.opam create mode 100644 lib/cmdlang_stdlib_runner/src/arg_runner.ml create mode 100644 lib/cmdlang_stdlib_runner/src/arg_runner.mli create mode 100644 lib/cmdlang_stdlib_runner/src/arg_state.ml create mode 100644 lib/cmdlang_stdlib_runner/src/arg_state.mli create mode 100644 lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.ml create mode 100644 lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.mli create mode 100644 lib/cmdlang_stdlib_runner/src/command_selector.ml create mode 100644 lib/cmdlang_stdlib_runner/src/command_selector.mli create mode 100644 lib/cmdlang_stdlib_runner/src/dune create mode 100644 lib/cmdlang_stdlib_runner/src/param_parser.ml create mode 100644 lib/cmdlang_stdlib_runner/src/param_parser.mli create mode 100644 lib/cmdlang_stdlib_runner/src/parser_state.ml create mode 100644 lib/cmdlang_stdlib_runner/src/parser_state.mli create mode 100644 lib/cmdlang_stdlib_runner/src/positional_state.ml create mode 100644 lib/cmdlang_stdlib_runner/src/positional_state.mli create mode 100644 lib/cmdlang_stdlib_runner/test/dune create mode 100644 test/cram/bin/stdlib-runner/dune create mode 100644 test/cram/bin/stdlib-runner/main_stdlib_runner.ml diff --git a/cmdlang-stdlib-runner.opam b/cmdlang-stdlib-runner.opam new file mode 100644 index 0000000..c44eedc --- /dev/null +++ b/cmdlang-stdlib-runner.opam @@ -0,0 +1,30 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A basic execution runner for cmdlang based on stdlib.arg" +maintainer: ["Mathieu Barbin "] +authors: ["Mathieu Barbin"] +license: "MIT" +homepage: "https://github.com/mbarbin/cmdlang" +doc: "https://mbarbin.github.io/cmdlang/" +bug-reports: "https://github.com/mbarbin/cmdlang/issues" +depends: [ + "dune" {>= "3.16"} + "ocaml" {>= "4.14"} + "cmdlang" {= version} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/mbarbin/cmdlang.git" diff --git a/cmdlang-tests.opam b/cmdlang-tests.opam index 8226acf..ca33339 100644 --- a/cmdlang-tests.opam +++ b/cmdlang-tests.opam @@ -18,6 +18,7 @@ depends: [ "cmdlang-to-base" {= version} "cmdlang-to-climate" {= version} "cmdlang-to-cmdliner" {= version} + "cmdlang-stdlib-runner" {= version} "cmdliner" {>= "1.3.0"} "core" {>= "v0.17" & < "v0.18"} "core_unix" {>= "v0.17" & < "v0.18"} diff --git a/dune-project b/dune-project index b898e42..b3a4cb6 100644 --- a/dune-project +++ b/dune-project @@ -103,6 +103,15 @@ (cmdlang (= :version)))) +(package + (name cmdlang-stdlib-runner) + (synopsis "A basic execution runner for cmdlang based on stdlib.arg") + (depends + (ocaml + (>= 4.14)) + (cmdlang + (= :version)))) + (package (name cmdlang-tests) (synopsis "Tests for cmdlang") @@ -133,6 +142,8 @@ (= :version)) (cmdlang-to-cmdliner (= :version)) + (cmdlang-stdlib-runner + (= :version)) (cmdliner (>= 1.3.0)) (core diff --git a/lib/cmdlang_stdlib_runner/src/arg_runner.ml b/lib/cmdlang_stdlib_runner/src/arg_runner.ml new file mode 100644 index 0000000..c5e8d9b --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/arg_runner.ml @@ -0,0 +1,28 @@ +type 'a t = + | Value : 'a -> 'a t + | Map : + { x : 'a t + ; f : 'a -> 'b + } + -> 'b t + | Both : 'a t * 'b t -> ('a * 'b) t + | Apply : + { f : ('a -> 'b) t + ; x : 'a t + } + -> 'b t + +let rec eval : type a. a t -> a = + fun (type a) (t : a t) : a -> + match t with + | Value a -> a + | Map { x; f } -> f (eval x) + | Both (a, b) -> + let a = eval a in + let b = eval b in + a, b + | Apply { f; x } -> + let f = eval f in + let x = eval x in + f x +;; diff --git a/lib/cmdlang_stdlib_runner/src/arg_runner.mli b/lib/cmdlang_stdlib_runner/src/arg_runner.mli new file mode 100644 index 0000000..91d9f36 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/arg_runner.mli @@ -0,0 +1,20 @@ +(** Internal representation used to run a parser. + + This is the final representation returned after all of the parsing phases + have completed, and is ready to run user code. *) + +type 'a t = + | Value : 'a -> 'a t + | Map : + { x : 'a t + ; f : 'a -> 'b + } + -> 'b t + | Both : 'a t * 'b t -> ('a * 'b) t + | Apply : + { f : ('a -> 'b) t + ; x : 'a t + } + -> 'b t + +val eval : 'a t -> 'a diff --git a/lib/cmdlang_stdlib_runner/src/arg_state.ml b/lib/cmdlang_stdlib_runner/src/arg_state.ml new file mode 100644 index 0000000..cc62235 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/arg_state.ml @@ -0,0 +1,190 @@ +type 'a t = + | Return : 'a -> 'a t + | Map : + { x : 'a t + ; f : 'a -> 'b + } + -> 'b t + | Both : 'a t * 'b t -> ('a * 'b) t + | Apply : + { f : ('a -> 'b) t + ; x : 'a t + } + -> 'b t + | Flag : + { names : string Ast.Nonempty_list.t + ; doc : string + ; var : bool ref + } + -> bool t + | Flag_count : + { names : string Ast.Nonempty_list.t + ; doc : string + ; var : int ref + } + -> int t + | Named : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Named_multi : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; rev_var : 'a list ref + } + -> 'a list t + | Named_opt : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a option t + | Named_with_default : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; default : 'a + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Pos : + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Pos_opt : + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a option t + | Pos_with_default : + { pos : int + ; param : 'a Ast.Param.t + ; default : 'a + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Pos_all : + { param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; rev_var : 'a list ref + } + -> 'a list t + +let rec create : type a. a Ast.Arg.t -> a t = + fun (type a) (arg : a Ast.Arg.t) -> + match arg with + | Return a -> Return a + | Map { x; f } -> + let x = create x in + Map { x; f } + | Both (x, y) -> + let x = create x in + let y = create y in + Both (x, y) + | Apply { f; x } -> + let f = create f in + let x = create x in + Apply { f; x } + | Flag { names; doc } -> Flag { names; doc; var = ref false } + | Flag_count { names; doc } -> Flag_count { names; doc; var = ref 0 } + | Named { names; param; docv; doc } -> Named { names; param; docv; doc; var = ref None } + | Named_multi { names; param; docv; doc } -> + Named_multi { names; param; docv; doc; rev_var = ref [] } + | Named_opt { names; param; docv; doc } -> + Named_opt { names; param; docv; doc; var = ref None } + | Named_with_default { names; param; default; docv; doc } -> + Named_with_default { names; param; default; docv; doc; var = ref None } + | Pos { pos; param; docv; doc } -> Pos { pos; param; docv; doc; var = ref None } + | Pos_opt { pos; param; docv; doc } -> Pos_opt { pos; param; docv; doc; var = ref None } + | Pos_with_default { pos; param; default; docv; doc } -> + Pos_with_default { pos; param; default; docv; doc; var = ref None } + | Pos_all { param; docv; doc } -> Pos_all { param; docv; doc; rev_var = ref [] } +;; + +module Parse_error = struct + type t = + | Missing_argument : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + } + -> t + | Missing_positional_argument : + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + } + -> t +end + +let finalize (type a) (t : a t) = + let ( let* ) = Result.bind in + let rec eval : type a. a t -> (a Arg_runner.t, Parse_error.t) Result.t = + fun (type a) (arg : a t) : (a Arg_runner.t, Parse_error.t) Result.t -> + match arg with + | Return a -> Ok (Arg_runner.Value a) + | Map { x; f } -> + let* x = eval x in + Ok (Arg_runner.Map { x; f }) + | Both (a, b) -> + let* a = eval a in + let* b = eval b in + Ok (Arg_runner.Both (a, b)) + | Apply { f; x } -> + let* f = eval f in + let* x = eval x in + Ok (Arg_runner.Apply { f; x }) + | Flag { names = _; doc = _; var } -> Ok (Arg_runner.Value var.contents) + | Flag_count { names = _; doc = _; var } -> Ok (Arg_runner.Value var.contents) + | Named { names; param; docv; doc; var } -> + (match var.contents with + | Some value -> Ok (Arg_runner.Value value) + | None -> Error (Parse_error.Missing_argument { names; param; docv; doc })) + | Named_multi { names = _; param = _; docv = _; doc = _; rev_var } -> + Ok (Arg_runner.Value (List.rev rev_var.contents)) + | Named_opt { names = _; param = _; docv = _; doc = _; var } -> + Ok (Arg_runner.Value var.contents) + | Named_with_default { names = _; param = _; default; docv = _; doc = _; var } -> + Ok + (Arg_runner.Value + (match var.contents with + | Some value -> value + | None -> default)) + | Pos { pos; param; docv; doc; var } -> + (match var.contents with + | Some value -> Ok (Arg_runner.Value value) + | None -> Error (Parse_error.Missing_positional_argument { pos; param; docv; doc })) + | Pos_opt { pos = _; param = _; docv = _; doc = _; var } -> + Ok (Arg_runner.Value var.contents) + | Pos_with_default { pos = _; param = _; default; docv = _; doc = _; var } -> + Ok + (Arg_runner.Value + (match var.contents with + | Some value -> value + | None -> default)) + | Pos_all { param = _; docv = _; doc = _; rev_var } -> + Ok (Arg_runner.Value (List.rev rev_var.contents)) + in + eval t +;; diff --git a/lib/cmdlang_stdlib_runner/src/arg_state.mli b/lib/cmdlang_stdlib_runner/src/arg_state.mli new file mode 100644 index 0000000..1879448 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/arg_state.mli @@ -0,0 +1,157 @@ +(** Internal representation for cmdlang arg expressions used during parsing. + + This is a projection of [Cmdlang.Ast.Arg.t] where we added mutable variables + to collect and store the intermediate results of parsing the command line + arguments during the parsing phase of the execution. + + To give a concrete example, let's look at the [Flag] construct. In the ast, + the type is: + + {[ + | Flag : + { names : string Ast.Nonempty_list.t + ; doc : string + } + -> bool t + ]} + + Note how, in this intermediate representation we added a new mutable field + as a place to collect and store the value for that flag: [var : bool ref]: + + {[ + | Flag : + { names : string Ast.Nonempty_list.t + ; doc : string + ; var : bool ref (* <== Added mutable field *) + } + -> bool t + ]} + + This [var] is where the parsing engine will store the value read from the + command line. Then the rest of the execution chain will be able to read the + value from there while going through this runtime ast for evaluation, after + the parsing is complete. *) + +type 'a t = + | Return : 'a -> 'a t + | Map : + { x : 'a t + ; f : 'a -> 'b + } + -> 'b t + | Both : 'a t * 'b t -> ('a * 'b) t + | Apply : + { f : ('a -> 'b) t + ; x : 'a t + } + -> 'b t + | Flag : + { names : string Ast.Nonempty_list.t + ; doc : string + ; var : bool ref + } + -> bool t + | Flag_count : + { names : string Ast.Nonempty_list.t + ; doc : string + ; var : int ref + } + -> int t + | Named : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Named_multi : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; rev_var : 'a list ref + } + -> 'a list t + | Named_opt : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a option t + | Named_with_default : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; default : 'a + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Pos : + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Pos_opt : + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a option t + | Pos_with_default : + { pos : int + ; param : 'a Ast.Param.t + ; default : 'a + ; docv : string option + ; doc : string + ; var : 'a option ref + } + -> 'a t + | Pos_all : + { param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; rev_var : 'a list ref + } + -> 'a list t + +(** Recursively allocate an arg state for all arguments contained in a parser. *) +val create : 'a Ast.Arg.t -> 'a t + +(** {1 Finalization} + + This part of the interface deals with finalizing the state and returning an + expression suitable for execution. + + It must be called last, once all the parsing and mutating is done. *) + +module Parse_error : sig + type t = + | Missing_argument : + { names : string Ast.Nonempty_list.t + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + } + -> t + | Missing_positional_argument : + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + } + -> t +end + +(** The idea with [finalize] is to split the execution into 2 isolated parts : + the part where the command line is parsed, and the part where user code is + actually ran. *) +val finalize : 'a t -> ('a Arg_runner.t, Parse_error.t) Result.t diff --git a/lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.ml b/lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.ml new file mode 100644 index 0000000..1d4298a --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.ml @@ -0,0 +1,168 @@ +module Arg_state = Arg_state +module Command_selector = Command_selector +module Param_parser = Param_parser +module Parser_state = Parser_state + +let usage_msg + ~argv + ~resume_parsing_from_index + ~summary + ~readme + ~subcommands + ~positional_state + = + let usage_prefix = + Array.sub argv 0 resume_parsing_from_index |> Array.to_list |> String.concat " " + in + let subcommands = + match subcommands with + | [] -> "" + | _ :: _ as subcommands -> + let subcommands = + subcommands + |> List.map (fun (name, command) -> + let summary = Ast.Command.summary command in + name, summary) + in + let padding = + List.fold_left (fun acc (name, _) -> max acc (String.length name)) 0 subcommands + + 2 + in + let items = + subcommands + |> List.map (fun (name, summary) -> + Printf.sprintf " %-*s %s" padding name summary) + |> String.concat "\n" + in + "Subcommands:\n" ^ items ^ "\n\n" + in + let positional_suffix, positional_state = + match + match positional_state with + | None -> None + | Some positional_state -> Positional_state.usage_msg positional_state + with + | None -> "", "" + | Some msg -> " [ARGUMENTS]", msg ^ "\n\n" + in + Printf.sprintf + "Usage: %s [OPTIONS]%s\n\n%s\n\n%s%s%sOptions:" + usage_prefix + positional_suffix + summary + (match readme with + | None -> "" + | Some m -> m () ^ "\n\n") + subcommands + positional_state +;; + +let eval_arg + (type a) + ~(arg : a Ast.Arg.t) + ~summary + ~readme + ~subcommands + ~argv + ~resume_parsing_from_index + = + let state = + match Parser_state.create arg with + | Ok state -> state + | Error (`Msg msg) -> + let message = "Invalid command specification (programming error):\n\n" ^ msg in + raise (Arg.Bad message) + in + let spec = Parser_state.spec state |> Arg.align in + let positional_state = Parser_state.positional_state state in + let anon_fun = Positional_state.anon_fun positional_state in + let usage_msg ~readme = + usage_msg + ~argv + ~resume_parsing_from_index + ~summary + ~readme + ~subcommands + ~positional_state:(Some positional_state) + in + let () = + let current = ref (resume_parsing_from_index - 1) in + try Arg.parse_argv ~current argv spec anon_fun (usage_msg ~readme:None) with + | Arg.Help _ -> + (* We rewrite the help in order to add the [readme] section. We do not + want to add it by default in the [Arg.Bad] case. *) + let message = Arg.usage_string spec (usage_msg ~readme) in + raise (Arg.Help message) + in + match Parser_state.finalize state with + | Ok runner -> Arg_runner.eval runner + | Error parse_error -> + (match parse_error with + | Arg_state.Parse_error.Missing_argument + { names = name :: _; param = _; docv = _; doc = _ } -> + raise (Arg.Bad (Printf.sprintf "Missing required named argument: %S.\n" name)) + | Arg_state.Parse_error.Missing_positional_argument + { pos; param = _; docv = _; doc = _ } -> + raise + (Arg.Bad + (Printf.sprintf "Missing required positional argument at position %d.\n" pos))) +;; + +let eval_internal (type a) (command : a Ast.Command.t) ~argv = + let { Command_selector.Selected.command; resume_parsing_from_index } = + Command_selector.select command ~argv + in + match command with + | Make { arg; summary; readme } -> + eval_arg ~arg ~summary ~readme ~subcommands:[] ~argv ~resume_parsing_from_index + | Group { default; summary; readme; subcommands } -> + (match default with + | Some arg -> + eval_arg ~arg ~summary ~readme ~subcommands ~argv ~resume_parsing_from_index + | None -> + let message = + usage_msg + ~argv + ~resume_parsing_from_index + ~summary + ~readme + ~subcommands + ~positional_state:None + in + let arg = + let message = Arg.usage_string [] message in + Ast.Arg.(Map { x = Return (); f = (fun () -> raise (Arg.Bad message)) }) + in + eval_arg ~arg ~summary ~readme ~subcommands ~argv ~resume_parsing_from_index) +;; + +module To_ast = Cmdlang.Command.Private.To_ast + +let eval a ~argv = + let command = a |> To_ast.command in + try Ok (eval_internal command ~argv) with + | Arg.Help msg -> Error (`Help msg) + | Arg.Bad msg -> Error (`Bad msg) +;; + +let eval_exit_code a ~argv = + match eval a ~argv with + | Ok () -> 0 + | Error (`Bad msg) -> + Printf.printf "%s" msg; + 2 + | Error (`Help msg) -> + Printf.printf "%s" msg; + 0 +;; + +let run a = + match eval a ~argv:Sys.argv with + | Ok a -> a + | Error (`Bad msg) -> + Printf.printf "%s" msg; + exit 2 + | Error (`Help msg) -> + Printf.printf "%s" msg; + exit 0 +;; diff --git a/lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.mli b/lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.mli new file mode 100644 index 0000000..35de932 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/cmdlang_stdlib_runner.mli @@ -0,0 +1,21 @@ +(** An execution engine for [cmdlang] based on [stdlib.arg]. *) + +val run : 'a Cmdlang.Command.t -> 'a + +val eval + : 'a Cmdlang.Command.t + -> argv:string array + -> ('a, [ `Help of string | `Bad of string ]) Result.t + +val eval_exit_code : unit Cmdlang.Command.t -> argv:string array -> int + +(** {1 Low level implementation} + + This modules should not be used directly by the users of the runner, but + only through the {!run} and {!eval} functions. They are exposed if you want + to re-use some existing code to build your own runner. *) + +module Arg_state = Arg_state +module Command_selector = Command_selector +module Param_parser = Param_parser +module Parser_state = Parser_state diff --git a/lib/cmdlang_stdlib_runner/src/command_selector.ml b/lib/cmdlang_stdlib_runner/src/command_selector.ml new file mode 100644 index 0000000..8d10848 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/command_selector.ml @@ -0,0 +1,22 @@ +module Selected = struct + type 'a t = + { command : 'a Ast.Command.t + ; resume_parsing_from_index : int + } +end + +let select (type a) command ~argv = + let rec aux index command = + match (command : a Ast.Command.t) with + | Make _ -> { Selected.command; resume_parsing_from_index = index } + | Group { default = _; summary = _; readme = _; subcommands } -> + if index >= Array.length argv + then { Selected.command; resume_parsing_from_index = index } + else ( + let arg = argv.(index) in + match subcommands |> List.find_opt (fun (name, _) -> String.equal arg name) with + | Some (_, subcommand) -> aux (index + 1) subcommand + | None -> { Selected.command; resume_parsing_from_index = index }) + in + aux 1 command +;; diff --git a/lib/cmdlang_stdlib_runner/src/command_selector.mli b/lib/cmdlang_stdlib_runner/src/command_selector.mli new file mode 100644 index 0000000..f37e620 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/command_selector.mli @@ -0,0 +1,26 @@ +(** Selecting a command within a group hierarchy. + + Cmdlang supports grouping subcommands into a nested tree, whereas + [stdlib.arg] works at the level of a command leaves. This module is used to + navigate the command tree to select the one based on the prefix of the + command line. + + For example, given the following command invocation: + + {[ + ./my_command group1 subcommand --flag value + ]} + + this module will select from the command tree the subcommand named + [subcommand] from the group [group1]. It will also return the index at which + the parsing should resume, in this case [3] (the index of [--flag] in + [Sys.argv]). *) + +module Selected : sig + type 'a t = + { command : 'a Ast.Command.t + ; resume_parsing_from_index : int + } +end + +val select : 'a Ast.Command.t -> argv:string array -> 'a Selected.t diff --git a/lib/cmdlang_stdlib_runner/src/dune b/lib/cmdlang_stdlib_runner/src/dune new file mode 100644 index 0000000..8fc9862 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/dune @@ -0,0 +1,17 @@ +(library + (name cmdlang_stdlib_runner) + (public_name cmdlang-stdlib-runner) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Cmdlang_ast) + (libraries cmdlang cmdlang_ast) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -allow-let-operators -check-doc-comments)) + (preprocess no_preprocessing)) diff --git a/lib/cmdlang_stdlib_runner/src/param_parser.ml b/lib/cmdlang_stdlib_runner/src/param_parser.ml new file mode 100644 index 0000000..f45d1db --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/param_parser.ml @@ -0,0 +1,76 @@ +let rec eval : type a. a Ast.Param.t -> string -> a Ast.or_error_msg = + fun (type a) (param : a Ast.Param.t) (str : string) : a Ast.or_error_msg -> + let err msg = Error (`Msg msg) in + match param with + | Conv { docv = _; parse; print = _ } -> parse str + | String -> Ok str + | Int -> + (match int_of_string_opt str with + | Some a -> Ok a + | None -> err (Printf.sprintf "invalid value %S (not an int)" str)) + | Float -> + (match float_of_string_opt str with + | Some a -> Ok a + | None -> err (Printf.sprintf "invalid value %S (not a float)" str)) + | Bool -> + (match bool_of_string_opt str with + | Some a -> Ok a + | None -> err (Printf.sprintf "invalid value %S (not a bool)" str)) + | File -> Ok str + | Enum { docv = _; choices = hd :: tl; to_string = _ } -> + (match hd :: tl |> List.find_opt (fun (choice, _) -> String.equal choice str) with + | Some (_, a) -> Ok a + | None -> err (Printf.sprintf "invalid value %S (not a valid choice)" str)) + | Comma_separated param -> + let params = String.split_on_char ',' str in + let oks, errors = + params + |> List.partition_map (fun str -> + match eval param str with + | Ok a -> Either.Left a + | Error (`Msg m) -> Either.Right m) + in + (match errors with + | [] -> Ok oks + | _ :: _ as msgs -> err (String.concat ", " msgs)) +;; + +let docv : type a. a Ast.Param.t -> docv:string option -> string = + fun param ~docv -> + let rec aux : type a. a Ast.Param.t -> docv:string option -> string = + fun (type a) (param : a Ast.Param.t) ~docv -> + match docv with + | Some v -> v + | None -> + let or_val = function + | Some v -> v + | None -> "VAL" + in + (match param with + | Conv { docv; parse = _; print = _ } -> or_val docv + | String -> "STRING" + | Int -> "INT" + | Float -> "FLOAT" + | Bool -> "BOOL" + | File -> "FILE" + | Enum { docv; choices = _; to_string = _ } -> or_val docv + | Comma_separated param -> aux param ~docv:None) + in + aux param ~docv +;; + +let rec print : type a. a Ast.Param.t -> a -> string = + fun (type a) (param : a Ast.Param.t) (a : a) : string -> + match param with + | Conv { docv = _; parse = _; print } -> Format.asprintf "%a" print a + | String -> a + | Int -> string_of_int a + | Float -> string_of_float a + | Bool -> string_of_bool a + | File -> a + | Enum { docv = _; choices = hd :: tl; to_string } -> + (match hd :: tl |> List.find_opt (fun (_, b) -> a == b) with + | Some (s, _) -> s + | None -> to_string a) + | Comma_separated param -> a |> List.map (fun a -> print param a) |> String.concat ", " +;; diff --git a/lib/cmdlang_stdlib_runner/src/param_parser.mli b/lib/cmdlang_stdlib_runner/src/param_parser.mli new file mode 100644 index 0000000..f4f1e61 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/param_parser.mli @@ -0,0 +1,22 @@ +(** Parsing parameters according to their specification. + + This is a util module to convert string based parameters coming from the + command line into their typed representation. + + For example, if a param is expected to be an integer, this module will + convert the string representation of the integer into an actual integer. + + {[ + ./my_command.exe --int-param 42 + ]} + + The string ["42"] will be converted into the integer [42], given the + parameter [Ast.Param.Int] for the arg [--int-param]. *) + +val eval : 'a Ast.Param.t -> string -> 'a Ast.or_error_msg + +(** Choose a docv for the help. *) +val docv : _ Ast.Param.t -> docv:string option -> string + +(** Print a param for the help (e.g. document a default value). *) +val print : 'a Ast.Param.t -> 'a -> string diff --git a/lib/cmdlang_stdlib_runner/src/parser_state.ml b/lib/cmdlang_stdlib_runner/src/parser_state.ml new file mode 100644 index 0000000..4a3dd92 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/parser_state.ml @@ -0,0 +1,146 @@ +let make_arg_spec + : type a. name:string -> a Ast.Param.t -> with_var:(a -> unit) -> Arg.spec + = + fun ~name param ~with_var -> + let unspecialized : type a. a Ast.Param.t -> with_var:(a -> unit) -> Arg.spec = + fun param ~with_var -> + Arg.String + (fun s -> + match Param_parser.eval param s with + | Ok v -> with_var v + | Error (`Msg m) -> + raise + (Arg.Bad (Printf.sprintf "Failed to parse the named argument %S: %s" name m))) + in + match param with + | String -> Arg.String with_var + | Int -> Arg.Int with_var + | Float -> Arg.Float with_var + | Bool -> Arg.Bool with_var + | File -> Arg.String with_var + | Enum { docv = _; choices = hd :: tl; to_string = _ } -> + let choices = hd :: tl in + let symbols = List.map fst choices in + Arg.Symbol + ( symbols + , fun symbol -> + choices + |> List.find (fun (choice, _) -> String.equal choice symbol) + |> snd + |> with_var ) + | Conv _ as param -> unspecialized param ~with_var + | Comma_separated _ as param -> unspecialized param ~with_var +;; + +let make_key ~name = + let length = String.length name in + if length > 0 && name.[0] = '-' + then name + else if length = 1 + then "-" ^ name + else "--" ^ name +;; + +let ( let* ) = Result.bind + +let make_docv param ~docv = + let docv = Param_parser.docv param ~docv in + Printf.sprintf "<%s>" docv +;; + +let compile + : type a. + a Arg_state.t + -> ((Arg.key * Arg.spec * Arg.doc) list * Positional_state.t) Ast.or_error_msg + = + fun t -> + let r = ref [] in + let pos_state = ref [] in + let pos_all_state = ref None in + let emit s = r := s :: !r in + let rec aux : type a. a Arg_state.t -> unit = + fun t -> + match t with + | Return (_ : a) -> () + | Map { x; f = _ } -> aux x + | Both (a, b) -> + aux a; + aux b + | Apply { f; x } -> + aux f; + aux x + | Flag { names = hd :: tl; doc; var } -> + hd :: tl |> List.iter (fun name -> emit (make_key ~name, Arg.Set var, " " ^ doc)) + | Flag_count { names = hd :: tl; doc; var } -> + hd :: tl + |> List.iter (fun name -> + emit (make_key ~name, Arg.Unit (fun () -> incr var), " " ^ doc)) + | Named { names = hd :: tl; param; docv; doc; var } -> + let docv = make_docv param ~docv in + hd :: tl + |> List.iter (fun name -> + emit + ( make_key ~name + , make_arg_spec ~name param ~with_var:(fun s -> var := Some s) + , docv ^ " " ^ doc )) + | Named_multi { names = hd :: tl; param; docv; doc; rev_var } -> + let docv = make_docv param ~docv in + hd :: tl + |> List.iter (fun name -> + emit + ( make_key ~name + , make_arg_spec ~name param ~with_var:(fun s -> rev_var := s :: !rev_var) + , docv ^ " " ^ doc )) + | Named_opt { names = hd :: tl; param; docv; doc; var } -> + let docv = make_docv param ~docv in + hd :: tl + |> List.iter (fun name -> + emit + ( make_key ~name + , make_arg_spec ~name param ~with_var:(fun s -> var := Some s) + , docv ^ " " ^ doc )) + | Named_with_default { names = hd :: tl; param; default = _; docv; doc; var } -> + let docv = make_docv param ~docv in + hd :: tl + |> List.iter (fun name -> + emit + ( make_key ~name + , make_arg_spec ~name param ~with_var:(fun s -> var := Some s) + , docv ^ " " ^ doc )) + | Pos { pos; param; docv; doc; var } -> + pos_state + := Positional_state.One_pos.T { pos; param; docv; doc; presence = Required; var } + :: !pos_state + | Pos_opt { pos; param; docv; doc; var } -> + pos_state + := Positional_state.One_pos.T { pos; param; docv; doc; presence = Optional; var } + :: !pos_state + | Pos_with_default { pos; param; default; docv; doc; var } -> + pos_state + := Positional_state.One_pos.T + { pos; param; docv; doc; presence = With_default default; var } + :: !pos_state + | Pos_all { param; docv; doc; rev_var } -> + pos_all_state := Some (Positional_state.Pos_all.T { param; docv; doc; rev_var }) + in + aux t; + let spec_list = !r in + let* positional_state = Positional_state.make ~pos:!pos_state ~pos_all:!pos_all_state in + Ok (spec_list, positional_state) +;; + +type 'a t = + { arg_state : 'a Arg_state.t + ; spec : (Arg.key * Arg.spec * Arg.doc) list + ; positional_state : Positional_state.t + } + +let create arg = + let arg_state = Arg_state.create arg in + let* spec, positional_state = compile arg_state in + Ok { arg_state; spec; positional_state } +;; + +let spec t = t.spec +let positional_state t = t.positional_state +let finalize t = Arg_state.finalize t.arg_state diff --git a/lib/cmdlang_stdlib_runner/src/parser_state.mli b/lib/cmdlang_stdlib_runner/src/parser_state.mli new file mode 100644 index 0000000..81d25e5 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/parser_state.mli @@ -0,0 +1,30 @@ +(** A mutable state that will collect parsing information. + + The strategy implemented by the cmdlang runner is to create such parser + state, enrich it during a parsing phases using [stdlib.arg], and once this + is done, return an expression suitable for evaluation. *) + +type 'a t + +(** {1 Initialization} + + In this part we allocate a parser state for a given parser. Once this is + done, the parser must be enriched with information coming from the command + line. *) + +val create : 'a Ast.Arg.t -> 'a t Ast.or_error_msg + +(** {1 Parsing} + + This part is what allows [stdlib.arg] to performs the expected side-effects + within the state. *) + +val spec : _ t -> (Arg.key * Arg.spec * Arg.doc) list +val positional_state : _ t -> Positional_state.t + +(** {1 Finalization} + + Once the parsing has been done, we can finalize the state and return an + evaluation suitable for execution. *) + +val finalize : 'a t -> ('a Arg_runner.t, Arg_state.Parse_error.t) Result.t diff --git a/lib/cmdlang_stdlib_runner/src/positional_state.ml b/lib/cmdlang_stdlib_runner/src/positional_state.ml new file mode 100644 index 0000000..d216977 --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/positional_state.ml @@ -0,0 +1,125 @@ +module Presence = struct + type 'a t = + | Required + | Optional + | With_default of 'a +end + +module One_pos = struct + type 'a t = + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; presence : 'a Presence.t + ; var : 'a option ref + } + + type packed = T : 'a t -> packed [@@unboxed] +end + +module Pos_all = struct + type 'a t = + { param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; rev_var : 'a list ref + } + + type packed = T : 'a t -> packed [@@unboxed] +end + +type t = + { pos : One_pos.packed array + ; pos_all : Pos_all.packed option + ; mutable current_pos : int + } + +let make_pos : One_pos.packed list -> One_pos.packed array Ast.or_error_msg = + fun l -> + let a = Array.of_list l in + Array.sort (fun (One_pos.T { pos = a; _ }) (T { pos = b; _ }) -> compare a b) a; + let skipped = + Array.find_mapi (fun i (One_pos.T { pos; _ }) -> if i <> pos then Some i else None) a + in + match skipped with + | None -> Ok a + | Some i -> + let message = + Printf.sprintf + "Attempted to declare a parser with a gap in its positional arguments.\n\ + Positional argument %d is missing.\n" + i + in + Error (`Msg message) +;; + +let ( let* ) = Result.bind + +let make ~pos ~pos_all = + let* pos = make_pos pos in + Ok { pos; pos_all; current_pos = 0 } +;; + +let anon_fun t anon = + let current_pos = t.current_pos in + t.current_pos <- succ current_pos; + if current_pos < Array.length t.pos + then ( + let (One_pos.T { pos; param; docv = _; doc = _; presence = _; var }) = + t.pos.(current_pos) + in + assert (pos = current_pos); + match Param_parser.eval param anon with + | Ok a -> var := Some a + | Error (`Msg error) -> + raise + (Arg.Bad + (Printf.sprintf "Failed to parse the argument at position %d: %s" pos error))) + else ( + match t.pos_all with + | None -> raise (Arg.Bad (Printf.sprintf "Unexpected positional argument %S" anon)) + | Some (Pos_all.T { param; docv = _; doc = _; rev_var }) -> + (match Param_parser.eval param anon with + | Ok a -> rev_var := a :: !rev_var + | Error (`Msg error) -> + raise + (Arg.Bad + (Printf.sprintf "Positional argument %d %S: %s" current_pos anon error)))) +;; + +let usage_msg { pos; pos_all; current_pos = _ } = + let pos = + Array.to_list pos + |> List.map (fun (One_pos.T { pos = _; param; docv; doc; presence; var = _ }) -> + let docv = Param_parser.docv param ~docv in + let doc = + if String.ends_with ~suffix:"." doc + then String.sub doc 0 (String.length doc - 1) + else doc + in + Printf.sprintf + " <%s> %s (%s)" + docv + doc + (match presence with + | Required -> "required" + | Optional -> "optional" + | With_default def -> Printf.sprintf "default %s" (Param_parser.print param def))) + in + let pos_all = + match pos_all with + | None -> [] + | Some (Pos_all.T { param; docv; doc; rev_var = _ }) -> + let docv = Param_parser.docv param ~docv in + let doc = + if String.ends_with ~suffix:"." doc + then String.sub doc 0 (String.length doc - 1) + else doc + in + [ Printf.sprintf " <%s>* %s (listed)" docv doc ] + in + match pos @ pos_all with + | [] -> None + | _ -> Some ("Arguments:\n" ^ String.concat "\n" pos) +;; diff --git a/lib/cmdlang_stdlib_runner/src/positional_state.mli b/lib/cmdlang_stdlib_runner/src/positional_state.mli new file mode 100644 index 0000000..4aaf20a --- /dev/null +++ b/lib/cmdlang_stdlib_runner/src/positional_state.mli @@ -0,0 +1,65 @@ +(** A mutable state that will collect parsing information for positional + arguments. + + This state is compiled from the AST representation of the command line and + is used to collect and store the values of positional arguments during the + calls to [Arg.anon_fun]. *) + +module Presence : sig + type 'a t = + | Required + | Optional + | With_default of 'a +end + +module One_pos : sig + type 'a t = + { pos : int + ; param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; presence : 'a Presence.t + ; var : 'a option ref + } + + type packed = T : 'a t -> packed [@@unboxed] +end + +module Pos_all : sig + type 'a t = + { param : 'a Ast.Param.t + ; docv : string option + ; doc : string + ; rev_var : 'a list ref + } + + type packed = T : 'a t -> packed [@@unboxed] +end + +type t = + { pos : One_pos.packed array + ; pos_all : Pos_all.packed option + ; mutable current_pos : int + } + +val make : pos:One_pos.packed list -> pos_all:Pos_all.packed option -> t Ast.or_error_msg + +(** Update the positional state based on the parsing of the next positional + argument in the command line.*) +val anon_fun : t -> Arg.anon_fun + +(** {1 Usage and help documentation} + + This section is dedicated to create contents to display for [--help] + messages, such as in: + + {[ + Usage: my_command [OPTIONS] [ARGUMENTS] + + ARGUMENTS: + description of arg1 + description of arg2 + ]} *) + +(** Return [None] if no positional arguments are expected. *) +val usage_msg : t -> string option diff --git a/lib/cmdlang_stdlib_runner/test/dune b/lib/cmdlang_stdlib_runner/test/dune new file mode 100644 index 0000000..2e7f90c --- /dev/null +++ b/lib/cmdlang_stdlib_runner/test/dune @@ -0,0 +1,33 @@ +(library + (name cmdlang_stdlib_runner_test) + (public_name cmdlang-tests.cmdlang_stdlib_runner_test) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Expect_test_helpers_base) + (libraries + base + cmdlang_stdlib_runner + expect_test_helpers_core.expect_test_helpers_base) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -allow-let-operators -check-doc-comments)) + (preprocess + (pps + -unused-code-warnings=force + ppx_compare + ppx_enumerate + ppx_expect + ppx_hash + ppx_here + ppx_let + ppx_sexp_conv + ppx_sexp_value))) diff --git a/test/cram/basic.t b/test/cram/basic.t index c3bf56b..d60db2c 100644 --- a/test/cram/basic.t +++ b/test/cram/basic.t @@ -55,6 +55,18 @@ String. ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe basic string --help + Usage: ./main_stdlib_runner.exe basic string [OPTIONS] [ARGUMENTS] + + print string + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options + And run it too. $ ./main_base.exe basic string Hello @@ -66,6 +78,9 @@ And run it too. $ ./main_cmdliner.exe basic string Hello Hello + $ ./main_stdlib_runner.exe basic string Hello + Hello + Int. $ ./main_base.exe basic int --help @@ -120,6 +135,17 @@ Int. SEE ALSO ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe basic int --help + Usage: ./main_stdlib_runner.exe basic int [OPTIONS] [ARGUMENTS] + + print int + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options And run it too. @@ -132,6 +158,9 @@ And run it too. $ ./main_cmdliner.exe basic int 17 17 + $ ./main_stdlib_runner.exe basic int 17 + 17 + Negative numbers are not supported as positional arguments since they look like flags. @@ -156,6 +185,20 @@ flags. Try './main_cmdliner.exe basic int --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe basic int -13 + int: unknown option '-13'. + Usage: ./main_stdlib_runner.exe basic int [OPTIONS] [ARGUMENTS] + + print int + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options + [2] + Float. $ ./main_base.exe basic float --help @@ -210,6 +253,17 @@ Float. SEE ALSO ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe basic float --help + Usage: ./main_stdlib_runner.exe basic float [OPTIONS] [ARGUMENTS] + + print float + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options And run it too. @@ -222,6 +276,9 @@ And run it too. $ ./main_cmdliner.exe basic float 3.14 3.14 + $ ./main_stdlib_runner.exe basic float 3.14 + 3.14 + Negative numbers are not supported as positional arguments since they look like flags. @@ -246,6 +303,20 @@ flags. Try './main_cmdliner.exe basic float --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe basic float -13.8 + float: unknown option '-13.8'. + Usage: ./main_stdlib_runner.exe basic float [OPTIONS] [ARGUMENTS] + + print float + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options + [2] + Bool. $ ./main_base.exe basic bool --help @@ -300,6 +371,17 @@ Bool. SEE ALSO ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe basic bool --help + Usage: ./main_stdlib_runner.exe basic bool [OPTIONS] [ARGUMENTS] + + print bool + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options And run it too. @@ -312,6 +394,11 @@ And run it too. $ ./main_cmdliner.exe basic bool true true + $ ./main_stdlib_runner.exe basic bool true + true + +-- + $ ./main_base.exe basic bool false false @@ -321,6 +408,11 @@ And run it too. $ ./main_cmdliner.exe basic bool false false + $ ./main_stdlib_runner.exe basic bool false + false + +-- + $ ./main_base.exe basic bool True Error parsing command line: @@ -344,6 +436,20 @@ And run it too. Try './main_cmdliner.exe basic bool --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe basic bool True + bool: Failed to parse the argument at position 0: invalid value "True" (not a bool). + Usage: ./main_stdlib_runner.exe basic bool [OPTIONS] [ARGUMENTS] + + print bool + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options + [2] + Invalid entry. $ ./main_base.exe basic bool Not_a_bool @@ -369,6 +475,20 @@ Invalid entry. Try './main_cmdliner.exe basic bool --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe basic bool Not_a_bool + bool: Failed to parse the argument at position 0: invalid value "Not_a_bool" (not a bool). + Usage: ./main_stdlib_runner.exe basic bool [OPTIONS] [ARGUMENTS] + + print bool + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options + [2] + File. $ ./main_base.exe basic file --help @@ -423,6 +543,17 @@ File. SEE ALSO ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe basic file --help + Usage: ./main_stdlib_runner.exe basic file [OPTIONS] [ARGUMENTS] + + print file + + Arguments: + value (required) + + Options: + -help Display this list of options + --help Display this list of options And run it too. @@ -438,11 +569,16 @@ And run it too. Try './main_cmdliner.exe basic file --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe basic file foo.txt + foo.txt + Same when the file actually exists $ echo "foo" | tee foo.txt foo +-- + $ ./main_base.exe basic file foo.txt foo.txt @@ -452,6 +588,11 @@ Same when the file actually exists $ ./main_cmdliner.exe basic file foo.txt foo.txt + $ ./main_stdlib_runner.exe basic file foo.txt + foo.txt + +-- + $ ./main_base.exe basic file /bogus/bar /bogus/bar @@ -463,3 +604,6 @@ Same when the file actually exists Usage: ./main_cmdliner.exe basic file [OPTION]… FILE Try './main_cmdliner.exe basic file --help' or './main_cmdliner.exe --help' for more information. [124] + + $ ./main_stdlib_runner.exe basic file /bogus/bar + /bogus/bar diff --git a/test/cram/bin/stdlib-runner/dune b/test/cram/bin/stdlib-runner/dune new file mode 100644 index 0000000..6b20c23 --- /dev/null +++ b/test/cram/bin/stdlib-runner/dune @@ -0,0 +1,7 @@ +(executable + (name main_stdlib_runner) + (flags :standard -w +a-4-40-41-42-44-45-48-66 -warn-error +a) + (libraries cmdlang_stdlib_runner cram_test_command) + (instrumentation + (backend bisect_ppx)) + (preprocess no_preprocessing)) diff --git a/test/cram/bin/stdlib-runner/main_stdlib_runner.ml b/test/cram/bin/stdlib-runner/main_stdlib_runner.ml new file mode 100644 index 0000000..55b71f9 --- /dev/null +++ b/test/cram/bin/stdlib-runner/main_stdlib_runner.ml @@ -0,0 +1 @@ +let () = Cmdlang_stdlib_runner.run Cram_test_command.Cmd.main diff --git a/test/cram/const.t b/test/cram/const.t index 72e899c..b5cb3d0 100644 --- a/test/cram/const.t +++ b/test/cram/const.t @@ -48,6 +48,14 @@ Checking the help when there are no arguments. SEE ALSO ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe return --help + Usage: ./main_stdlib_runner.exe return [OPTIONS] + + An empty command + + Options: + -help Display this list of options + --help Display this list of options And run it too. @@ -59,3 +67,6 @@ And run it too. $ ./main_cmdliner.exe return () + + $ ./main_stdlib_runner.exe return + () diff --git a/test/cram/doc.t b/test/cram/doc.t index 7d21d7e..26e8a81 100644 --- a/test/cram/doc.t +++ b/test/cram/doc.t @@ -74,6 +74,23 @@ ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe doc --help + Usage: ./main_stdlib_runner.exe doc [OPTIONS] + + Testing documentation features + + + This group is dedicated to testing documentation features. + + + Subcommands: + args-doc-end-with-dots Args doc end with dots + singleton-with-readme Singleton command with a readme + + Options: + -help Display this list of options + --help Display this list of options + A singleton command with a readme: $ ./main_base.exe doc singleton-with-readme --help @@ -138,6 +155,21 @@ A singleton command with a readme: SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe doc singleton-with-readme --help + Usage: ./main_stdlib_runner.exe doc singleton-with-readme [OPTIONS] + + Singleton command with a readme + + + This is a readme. + It can be written on multiple lines. + + + Options: + -help Display this list of options + --help Display this list of options + Arguments doc created with or without dots at the end. Positional arguments are currently not documented in the help output of the base and climate commands, but they are in the cmdliner command. In cmdliner, we currently add the trailing @@ -172,10 +204,10 @@ dot to the documentation string if it is not present. ARGUMENTS STRING (required) - The doc for a ends with a dot. + The doc for [a] in the code ends with a dot. STRING (required) - The doc for b doesn't. + The doc for [b] doesn't. COMMON OPTIONS --help[=FMT] (default=auto) @@ -200,3 +232,17 @@ dot to the documentation string if it is not present. SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe doc args-doc-end-with-dots --help + Usage: ./main_stdlib_runner.exe doc args-doc-end-with-dots [OPTIONS] [ARGUMENTS] + + Args doc end with dots + + Arguments: + The doc for [a] in the code ends with a dot (required) + The doc for [b] doesn't (required) + + Options: + -help Display this list of options + --help Display this list of options + diff --git a/test/cram/dune b/test/cram/dune index b9b66ff..b925444 100644 --- a/test/cram/dune +++ b/test/cram/dune @@ -7,10 +7,14 @@ (rule (copy bin/cmdliner/main_cmdliner.exe main_cmdliner.exe)) +(rule + (copy bin/stdlib-runner/main_stdlib_runner.exe main_stdlib_runner.exe)) + (cram (package cmdlang-tests) (deps (package cmdlang) main_base.exe main_climate.exe - main_cmdliner.exe)) + main_cmdliner.exe + main_stdlib_runner.exe)) diff --git a/test/cram/main-help.t b/test/cram/main-help.t index 408c291..a0ac932 100644 --- a/test/cram/main-help.t +++ b/test/cram/main-help.t @@ -74,3 +74,18 @@ the executable for each backend. 125 on unexpected internal errors (bugs). + + $ ./main_stdlib_runner.exe --help + Usage: ./main_stdlib_runner.exe [OPTIONS] + + Cram Test Command + + Subcommands: + basic Basic types + doc Testing documentation features + named Named arguments + return An empty command + + Options: + -help Display this list of options + --help Display this list of options diff --git a/test/cram/named-opt.t b/test/cram/named-opt.t index d4195bc..f4b69bc 100644 --- a/test/cram/named-opt.t +++ b/test/cram/named-opt.t @@ -58,12 +58,28 @@ Let's start with characterizing whether and how the default value appears in the ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe named opt string-with-docv --help + Usage: ./main_stdlib_runner.exe named opt string-with-docv [OPTIONS] + + Named_opt__string_with_docv + + Options: + --who Hello WHO? + -help Display this list of options + --help Display this list of options + +-- + $ ./main_base.exe named opt string-with-docv $ ./main_climate.exe named opt string-with-docv $ ./main_cmdliner.exe named opt string-with-docv + $ ./main_stdlib_runner.exe named opt string-with-docv + +-- + $ ./main_base.exe named opt string-with-docv --who Alice Hello Alice @@ -73,6 +89,9 @@ Let's start with characterizing whether and how the default value appears in the $ ./main_cmdliner.exe named opt string-with-docv --who Alice Hello Alice + $ ./main_stdlib_runner.exe named opt string-with-docv --who Alice + Hello Alice + Characterizing the flag documentation when the `docv` parameter is not supplied. $ ./main_base.exe named opt string-without-docv --help @@ -131,3 +150,14 @@ Characterizing the flag documentation when the `docv` parameter is not supplied. SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe named opt string-without-docv --help + Usage: ./main_stdlib_runner.exe named opt string-without-docv [OPTIONS] + + Named_opt__string_without_docv + + Options: + --who Hello WHO? + -help Display this list of options + --help Display this list of options + diff --git a/test/cram/named-with-default.t b/test/cram/named-with-default.t index 547063b..b3e974f 100644 --- a/test/cram/named-with-default.t +++ b/test/cram/named-with-default.t @@ -67,6 +67,16 @@ parentheses. See `(absent=...)` below. ./main_cmdliner.exe(1) + $ ./main_stdlib_runner.exe named with-default string --help + Usage: ./main_stdlib_runner.exe named with-default string [OPTIONS] + + Named_with_default__string + + Options: + --who Hello WHO? + -help Display this list of options + --help Display this list of options + Let's check behavior when the default value is used. $ ./main_base.exe named with-default string @@ -78,6 +88,9 @@ Let's check behavior when the default value is used. $ ./main_cmdliner.exe named with-default string Hello World + $ ./main_stdlib_runner.exe named with-default string + Hello World + And when a value is provided. $ ./main_base.exe named with-default string --who You @@ -89,6 +102,9 @@ And when a value is provided. $ ./main_cmdliner.exe named with-default string --who=You Hello You + $ ./main_stdlib_runner.exe named with-default string --who=You + Hello You + We also exercises some default for param constructs involving custom print functions or parsers generated from modules with utils. @@ -101,6 +117,11 @@ functions or parsers generated from modules with utils. $ ./main_cmdliner.exe named with-default create --who=A Hello A + $ ./main_stdlib_runner.exe named with-default create --who=A + Hello A + +-- + $ ./main_base.exe named with-default create --who B Hello B @@ -110,6 +131,11 @@ functions or parsers generated from modules with utils. $ ./main_cmdliner.exe named with-default create --who=B Hello B + $ ./main_stdlib_runner.exe named with-default create --who=B + Hello B + +-- + $ ./main_base.exe named with-default create --who C Error parsing command line: @@ -132,6 +158,20 @@ functions or parsers generated from modules with utils. Try './main_cmdliner.exe named with-default create --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe named with-default create --who C + create: Failed to parse the named argument "who": "C": invalid E.t. + Usage: ./main_stdlib_runner.exe named with-default create [OPTIONS] + + Named_with_default__create + + Options: + --who <(A|B)> Greet A or B? + -help Display this list of options + --help Display this list of options + [2] + +-- + $ ./main_base.exe named with-default create --help Named_with_default__create @@ -188,6 +228,17 @@ functions or parsers generated from modules with utils. SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe named with-default create --help + Usage: ./main_stdlib_runner.exe named with-default create [OPTIONS] + + Named_with_default__create + + Options: + --who <(A|B)> Greet A or B? + -help Display this list of options + --help Display this list of options + Named-with-default with a stringable parameter. $ ./main_base.exe named with-default stringable --help @@ -246,6 +297,19 @@ Named-with-default with a stringable parameter. SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe named with-default stringable --help + Usage: ./main_stdlib_runner.exe named with-default stringable [OPTIONS] + + Named_with_default__stringable + + Options: + --who identifier + -help Display this list of options + --help Display this list of options + +-- + $ ./main_base.exe named with-default stringable Hello my-id @@ -255,6 +319,9 @@ Named-with-default with a stringable parameter. $ ./main_cmdliner.exe named with-default stringable Hello my-id + $ ./main_stdlib_runner.exe named with-default stringable + Hello my-id + Named-with-default with a validated string parameter. $ ./main_base.exe named with-default validated --help @@ -313,6 +380,19 @@ Named-with-default with a validated string parameter. SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe named with-default validated --help + Usage: ./main_stdlib_runner.exe named with-default validated [OPTIONS] + + Named_with_default__validated + + Options: + --who 4 letters alphanumerical identifier + -help Display this list of options + --help Display this list of options + +-- + $ ./main_base.exe named with-default validated Hello 0000 @@ -322,6 +402,9 @@ Named-with-default with a validated string parameter. $ ./main_cmdliner.exe named with-default validated Hello 0000 + $ ./main_stdlib_runner.exe named with-default validated + Hello 0000 + Invalid entry for the validated string parameter. $ ./main_base.exe named with-default validated --who foo @@ -347,6 +430,18 @@ Invalid entry for the validated string parameter. Try './main_cmdliner.exe named with-default validated --help' or './main_cmdliner.exe --help' for more information. [124] + $ ./main_stdlib_runner.exe named with-default validated --who foo + validated: Failed to parse the named argument "who": "foo": invalid 4 letters alphanumerical identifier. + Usage: ./main_stdlib_runner.exe named with-default validated [OPTIONS] + + Named_with_default__validated + + Options: + --who 4 letters alphanumerical identifier + -help Display this list of options + --help Display this list of options + [2] + Valid entry for the validated string parameter. $ ./main_base.exe named with-default validated --who foo7 @@ -358,6 +453,9 @@ Valid entry for the validated string parameter. $ ./main_cmdliner.exe named with-default validated --who foo7 Hello foo7 + $ ./main_stdlib_runner.exe named with-default validated --who foo7 + Hello foo7 + Named-with-default with a comma-separated string parameter. $ ./main_base.exe named with-default comma-separated --help @@ -416,6 +514,19 @@ Named-with-default with a comma-separated string parameter. SEE ALSO ./main_cmdliner.exe(1) + + $ ./main_stdlib_runner.exe named with-default comma-separated --help + Usage: ./main_stdlib_runner.exe named with-default comma-separated [OPTIONS] + + Named_with_default__comma_separated + + Options: + --who Hello WHO? + -help Display this list of options + --help Display this list of options + +-- + $ ./main_base.exe named with-default comma-separated Hello World @@ -425,6 +536,9 @@ Named-with-default with a comma-separated string parameter. $ ./main_cmdliner.exe named with-default comma-separated Hello World + $ ./main_stdlib_runner.exe named with-default comma-separated + Hello World + Valid entry for the parameter. $ ./main_base.exe named with-default comma-separated --who You,Me @@ -438,3 +552,7 @@ Valid entry for the parameter. $ ./main_cmdliner.exe named with-default comma-separated --who You,Me Hello You Hello Me + + $ ./main_stdlib_runner.exe named with-default comma-separated --who You,Me + Hello You + Hello Me diff --git a/test/cram/src/cmd.ml b/test/cram/src/cmd.ml index cfae1b0..a396f9b 100644 --- a/test/cram/src/cmd.ml +++ b/test/cram/src/cmd.ml @@ -71,8 +71,9 @@ It can be written on multiple lines. Command.make ~summary:"Args doc end with dots" (let open Command.Std in - let+ _ = Arg.pos ~pos:0 Param.string ~doc:"The doc for a ends with a dot." - and+ _ = Arg.pos ~pos:1 Param.string ~doc:"The doc for b doesn't" in + let+ _ = + Arg.pos ~pos:0 Param.string ~doc:"The doc for [a] in the code ends with a dot." + and+ _ = Arg.pos ~pos:1 Param.string ~doc:"The doc for [b] doesn't" in (() [@coverage off])) ;; @@ -117,6 +118,21 @@ module Named = struct end module With_default = struct + let int = + Command.make + ~summary:"Named_with_default__int" + (let open Command.Std in + let+ x = + Arg.named_with_default + [ "x" ] + Param.int + ~docv:"X" + ~default:42 + ~doc:"Print Hello X" + in + print_endline ("Hello " ^ Int.to_string x)) + ;; + let string = Command.make ~summary:"Named_with_default__string" @@ -255,6 +271,7 @@ module Named = struct Command.group ~summary:"Testing named-with-default" [ "create", create + ; "int", int ; "string", string ; "stringable", stringable ; "validated", validated diff --git a/test/expect/arg_test.ml b/test/expect/arg_test.ml index 9cdb6bb..c1f8fc8 100644 --- a/test/expect/arg_test.ml +++ b/test/expect/arg_test.ml @@ -1,7 +1,8 @@ module Core_command = Command type 'a t = - { base : ('a Core_command.Param.t, Exn.t) Result.t + { arg : 'a Cmdlang.Command.Arg.t + ; base : ('a Core_command.Param.t, Exn.t) Result.t ; climate : ('a Climate.Arg_parser.t, Exn.t) Result.t ; cmdliner : ('a Cmdliner.Term.t, Exn.t) Result.t } @@ -23,7 +24,7 @@ let create arg = | term -> Ok term | exception e -> Error e [@coverage off] in - { base; climate; cmdliner } + { arg; base; climate; cmdliner } ;; module Backend = struct @@ -31,6 +32,7 @@ module Backend = struct | Climate | Cmdliner | Core_command + | Stdlib_runner [@@deriving enumerate, sexp_of] let to_string t = Sexp.to_string (sexp_of_t t) @@ -98,6 +100,17 @@ let eval_cmdliner t { Command_line.prog; args } = | exception e -> print_s [%sexp "Evaluation Raised", (e : Exn.t)] [@coverage off]) ;; +let eval_stdlib_runner t { Command_line.prog; args } = + let command = Cmdlang.Command.make t.arg ~summary:"eval-stdlib-runner" in + match Cmdlang_stdlib_runner.eval command ~argv:(Array.of_list (prog :: args)) with + | Ok () -> () + | Error (`Help msg) -> print_endline msg + | Error (`Bad msg) -> + Stdlib.print_string msg; + print_s [%sexp "Evaluation Failed", { exit_code = (2 : int) }] [@coverage off] + | exception e -> print_s [%sexp "Evaluation Raised", (e : Exn.t)] [@coverage off] +;; + let eval_all t command_line = List.iter Backend.all ~f:(fun backend -> print_endline @@ -107,7 +120,8 @@ let eval_all t command_line = (match backend with | Climate -> eval_climate t command_line | Cmdliner -> eval_cmdliner t command_line - | Core_command -> eval_base t command_line); + | Core_command -> eval_base t command_line + | Stdlib_runner -> eval_stdlib_runner t command_line); Stdlib.(flush stdout); Stdlib.(flush stderr)); () diff --git a/test/expect/dune b/test/expect/dune index 5a9dceb..9088a5f 100644 --- a/test/expect/dune +++ b/test/expect/dune @@ -16,6 +16,7 @@ base climate cmdlang + cmdlang-stdlib-runner cmdlang-to-base cmdlang-to-climate cmdlang-to-cmdliner diff --git a/test/expect/test__applicative_operations.ml b/test/expect/test__applicative_operations.ml index 8b7ba1e..bd3ee42 100644 --- a/test/expect/test__applicative_operations.ml +++ b/test/expect/test__applicative_operations.ml @@ -15,6 +15,8 @@ let%expect_test "const" = hello ----------------------------------------------------- Core_command hello + ----------------------------------------------------- Stdlib_runner + hello |}]; () ;; @@ -36,6 +38,8 @@ let%expect_test "map" = (0) ----------------------------------------------------- Core_command (0) + ----------------------------------------------------- Stdlib_runner + (0) |}]; Arg_test.eval_all test { prog = "test"; args = [ "not-an-int" ] }; [%expect @@ -46,6 +50,8 @@ let%expect_test "map" = () ----------------------------------------------------- Core_command () + ----------------------------------------------------- Stdlib_runner + () |}]; Arg_test.eval_all test { prog = "test"; args = [ "42" ] }; [%expect @@ -56,6 +62,8 @@ let%expect_test "map" = (42) ----------------------------------------------------- Core_command (42) + ----------------------------------------------------- Stdlib_runner + (42) |}]; () ;; @@ -97,6 +105,8 @@ let%expect_test "apply" = 1 ----------------------------------------------------- Core_command 1 + ----------------------------------------------------- Stdlib_runner + 1 |}]; Arg_test.eval_all test { prog = "test"; args = [ "pred"; "42" ] }; [%expect @@ -107,6 +117,8 @@ let%expect_test "apply" = 41 ----------------------------------------------------- Core_command 41 + ----------------------------------------------------- Stdlib_runner + 41 |}]; () ;; diff --git a/test/expect/test__cmd_name_with_underscore.ml b/test/expect/test__cmd_name_with_underscore.ml index a255fa5..574462f 100644 --- a/test/expect/test__cmd_name_with_underscore.ml +++ b/test/expect/test__cmd_name_with_underscore.ml @@ -41,3 +41,14 @@ let%expect_test "cmdliner" = [%expect {| 0 |}]; () ;; + +let%expect_test "stdlib-runner" = + (* In the stdlib-runner, subcommand names containing an underscore are valid. *) + (match + Cmdlang_stdlib_runner.eval group ~argv:[| "./main.exe"; "name_with_underscore" |] + with + | Ok () -> () + | Error _ -> assert false); + [%expect {||}]; + () +;; diff --git a/test/expect/test__flag.ml b/test/expect/test__flag.ml index 563e252..f255e07 100644 --- a/test/expect/test__flag.ml +++ b/test/expect/test__flag.ml @@ -12,6 +12,7 @@ let%expect_test "flag" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; (* When full flags are provided, all backend agree and things work as expected. *) Arg_test.eval_all test { prog = "test"; args = [ "--print-hello" ] }; @@ -23,6 +24,8 @@ let%expect_test "flag" = Hello ----------------------------------------------------- Core_command Hello + ----------------------------------------------------- Stdlib_runner + Hello |}]; (* When the specification does not include an explicit one letter alias, none is provided. We say more about this in a dedicated section below. *) @@ -39,6 +42,17 @@ let%expect_test "flag" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"unknown flag -p\")")) + ----------------------------------------------------- Stdlib_runner + test: unknown option '-p'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + --print-hello print Hello + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; (* The default translation configured in [cmdlang] doesn't enable special support for long flag names with a single dash. That is reserved to special @@ -57,8 +71,19 @@ let%expect_test "flag" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"unknown flag -print-hello\")")) + ----------------------------------------------------- Stdlib_runner + test: unknown option '-print-hello'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + --print-hello print Hello + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; - (* Partial flags are handled differently by the backend. In [climate], they + (* Partial flags are handled differently by the backends. In [climate], they are rejected. In [cmdliner] and [core.command], prefixes are interpreted as full flags. We say more about this in a dedicated section below. *) Arg_test.eval_all test { prog = "test"; args = [ "--print" ] }; @@ -70,6 +95,17 @@ let%expect_test "flag" = Hello ----------------------------------------------------- Core_command Hello + ----------------------------------------------------- Stdlib_runner + test: unknown option '--print'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + --print-hello print Hello + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -87,6 +123,7 @@ let%expect_test "1-letter-flag" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; (* One letter flags are expected to be supplied with a single dash. *) Arg_test.eval_all test { prog = "test"; args = [ "-p" ] }; @@ -98,6 +135,8 @@ let%expect_test "1-letter-flag" = Hello ----------------------------------------------------- Core_command Hello + ----------------------------------------------------- Stdlib_runner + Hello |}]; (* One letter flags are not recognized with called with two dashes. All backend agree on that. *) Arg_test.eval_all test { prog = "test"; args = [ "--p" ] }; @@ -115,6 +154,17 @@ let%expect_test "1-letter-flag" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"unknown flag --p\")")) + ----------------------------------------------------- Stdlib_runner + test: unknown option '--p'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + -p print Hello + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -133,6 +183,7 @@ let%expect_test "1-letter-alias" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; (* When full flags are provided, all backend agree and things work as expected. *) Arg_test.eval_all test { prog = "test"; args = [ "--print-hello" ] }; @@ -144,6 +195,8 @@ let%expect_test "1-letter-alias" = Hello ----------------------------------------------------- Core_command Hello + ----------------------------------------------------- Stdlib_runner + Hello |}]; (* The specification now includes an explicit one letter alias. *) Arg_test.eval_all test { prog = "test"; args = [ "-p" ] }; @@ -155,6 +208,8 @@ let%expect_test "1-letter-alias" = Hello ----------------------------------------------------- Core_command Hello + ----------------------------------------------------- Stdlib_runner + Hello |}]; (* One letter flags may not be called with 2 dashes. However, since [cmdliner] and [core.command] allow partial flags, if the one letter is actually the @@ -171,6 +226,18 @@ let%expect_test "1-letter-alias" = Hello ----------------------------------------------------- Core_command Hello + ----------------------------------------------------- Stdlib_runner + test: unknown option '--p'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + -p print Hello + --print-hello print Hello + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -191,6 +258,7 @@ let%expect_test "ambiguous prefixes" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; (* When full flags are provided, all backend agree and things work as expected. *) Arg_test.eval_all test { prog = "test"; args = [ "--print-hello-you" ] }; @@ -202,6 +270,8 @@ let%expect_test "ambiguous prefixes" = Hello You ----------------------------------------------------- Core_command Hello You + ----------------------------------------------------- Stdlib_runner + Hello You |}]; Arg_test.eval_all test { prog = "test"; args = [ "--print-hello-world" ] }; [%expect @@ -212,6 +282,8 @@ let%expect_test "ambiguous prefixes" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; (* When the flags are supplied partially, the backend diverge. If the prefix is non-ambiguous, [cmdliner] and [core.command] accept it. *) @@ -225,6 +297,18 @@ let%expect_test "ambiguous prefixes" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + test: unknown option '--print-hello-w'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + --print-hello-world print Hello World + --print-hello-you print Hello You + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; (* When the prefix is ambiguous, it is rejected. *) Arg_test.eval_all test { prog = "test"; args = [ "--print-hello" ] }; @@ -241,6 +325,18 @@ let%expect_test "ambiguous prefixes" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"flag --print-hello is an ambiguous prefix: --print-hello-world, --print-hello-you\")")) + ----------------------------------------------------- Stdlib_runner + test: unknown option '--print-hello'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + --print-hello-world print Hello World + --print-hello-you print Hello You + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -262,6 +358,8 @@ let%expect_test "flag_count" = ----------------------------------------------------- Core_command ("Translation Raised" ( "Flag_count not supported by core.command" ((names (count c)) (doc count)))) + ----------------------------------------------------- Stdlib_runner + ((count 0)) |}]; (* We want to verify that the same count is updated by any of the alias. *) Arg_test.eval_all test { prog = "test"; args = [ "--count"; "-c"; "-c" ] }; @@ -274,6 +372,8 @@ let%expect_test "flag_count" = ----------------------------------------------------- Core_command ("Translation Raised" ( "Flag_count not supported by core.command" ((names (count c)) (doc count)))) + ----------------------------------------------------- Stdlib_runner + ((count 3)) |}]; () ;; diff --git a/test/expect/test__invalid_pos_opt.ml b/test/expect/test__invalid_pos_opt.ml index 2597e81..97bf23f 100644 --- a/test/expect/test__invalid_pos_opt.ml +++ b/test/expect/test__invalid_pos_opt.ml @@ -20,6 +20,8 @@ let%expect_test "invalid_pos_sequence" = ((a (A)) (b B)) ----------------------------------------------------- Core_command ((a (A)) (b B)) + ----------------------------------------------------- Stdlib_runner + ((a (A)) (b B)) |}]; Arg_test.eval_all test { prog = "test"; args = [ "B" ] }; [%expect @@ -34,6 +36,9 @@ let%expect_test "invalid_pos_sequence" = ("Evaluation Failed" ((exit_code 124))) ----------------------------------------------------- Core_command ("Evaluation Failed" "missing anonymous argument: STRING") + ----------------------------------------------------- Stdlib_runner + Missing required positional argument at position 1. + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -93,3 +98,23 @@ let%expect_test "cmdliner" = |}]; () ;; + +let%expect_test "stdlib-runner" = + let run args = + Cmdlang_stdlib_runner.eval_exit_code + cmd + ~argv:(Array.concat [ [| "./main.exe" |]; Array.of_list args ]) + |> Stdlib.print_int + in + run [ "A"; "B" ]; + [%expect {| + ((a (A)) (b B)) + 0 + |}]; + run [ "B" ]; + [%expect {| + Missing required positional argument at position 1. + 2 + |}]; + () +;; diff --git a/test/expect/test__named.ml b/test/expect/test__named.ml index 5e3dc90..be7d6a2 100644 --- a/test/expect/test__named.ml +++ b/test/expect/test__named.ml @@ -21,6 +21,9 @@ let%expect_test "named" = ("Evaluation Failed" ((exit_code 124))) ----------------------------------------------------- Core_command ("Evaluation Failed" "missing required flag: --who") + ----------------------------------------------------- Stdlib_runner + Missing required named argument: "who". + ("Evaluation Failed" ((exit_code 2))) |}]; Arg_test.eval_all test { prog = "test"; args = [ "--who"; "World" ] }; [%expect @@ -31,8 +34,11 @@ let%expect_test "named" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; - (* [climate] and [cmdliner] support the [--arg=VALUE] syntax. [core.command] does not. *) + (* [climate], [cmdliner] and [stdlib-runner] support the [--arg=VALUE] syntax. + [core.command] does not. *) Arg_test.eval_all test { prog = "test"; args = [ "--who=You" ] }; [%expect {| @@ -43,6 +49,8 @@ let%expect_test "named" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"unknown flag --who=You\")")) + ----------------------------------------------------- Stdlib_runner + Hello You |}]; () ;; @@ -68,6 +76,9 @@ let%expect_test "1-letter-named" = ("Evaluation Failed" ((exit_code 124))) ----------------------------------------------------- Core_command ("Evaluation Failed" "missing required flag: -w") + ----------------------------------------------------- Stdlib_runner + Missing required named argument: "w". + ("Evaluation Failed" ((exit_code 2))) |}]; Arg_test.eval_all test { prog = "test"; args = [ "-w"; "World" ] }; [%expect @@ -78,8 +89,26 @@ let%expect_test "1-letter-named" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; - (* [climate] and [cmdliner] support the [-wVALUE] syntax. [core.command] does not. *) + (* [climate], [cmdliner] and [stdlib-runner] support the [-a=VALUE] syntax. + [core.command] does not. *) + Arg_test.eval_all test { prog = "test"; args = [ "-w=You" ] }; + [%expect + {| + ----------------------------------------------------- Climate + Hello =You + ----------------------------------------------------- Cmdliner + Hello =You + ----------------------------------------------------- Core_command + ("Evaluation Failed" ( + "Command.Failed_to_parse_command_line(\"unknown flag -w=You\")")) + ----------------------------------------------------- Stdlib_runner + Hello You + |}]; + (* [climate] and [cmdliner] support the [-wVALUE] syntax. [core.command] and + [cmdlang] do not. *) Arg_test.eval_all test { prog = "test"; args = [ "-wYou" ] }; [%expect {| @@ -90,6 +119,17 @@ let%expect_test "1-letter-named" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"unknown flag -wYou\")")) + ----------------------------------------------------- Stdlib_runner + test: unknown option '-wYou'. + Usage: test [OPTIONS] + + eval-stdlib-runner + + Options: + -w hello who? + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -108,6 +148,7 @@ let%expect_test "named_multi" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; Arg_test.eval_all test { prog = "test"; args = [ "--who"; "World" ] }; [%expect @@ -118,6 +159,8 @@ let%expect_test "named_multi" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; Arg_test.eval_all test @@ -138,6 +181,10 @@ let%expect_test "named_multi" = Hello World Hello You Hello Me + ----------------------------------------------------- Stdlib_runner + Hello World + Hello You + Hello Me |}]; () ;; @@ -156,6 +203,7 @@ let%expect_test "named_opt" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; Arg_test.eval_all test { prog = "test"; args = [ "--who"; "World" ] }; [%expect @@ -166,6 +214,8 @@ let%expect_test "named_opt" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; () ;; @@ -192,6 +242,8 @@ let%expect_test "named_with_default" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; Arg_test.eval_all test { prog = "test"; args = [ "--who"; "You" ] }; [%expect @@ -202,6 +254,8 @@ let%expect_test "named_with_default" = Hello You ----------------------------------------------------- Core_command Hello You + ----------------------------------------------------- Stdlib_runner + Hello You |}]; () ;; @@ -234,6 +288,10 @@ let%expect_test "named_with_default__comma_separated" = Hello You Hello Me Hello World + ----------------------------------------------------- Stdlib_runner + Hello You + Hello Me + Hello World |}]; Arg_test.eval_all (test ~default:[] ()) { prog = "test"; args = [] }; [%expect @@ -241,11 +299,12 @@ let%expect_test "named_with_default__comma_separated" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; - (* Empty values are currently treated inconsistently by the three - translation+backend. In climate, you get a singleton made of the empty - string, in cmdliner you get the empty list, and in core.command you get an - error. *) + (* Empty values are currently treated inconsistently by the translation + backends. In [climate] and [stdlib-runner], you get a singleton made of the + empty string, in [cmdliner] you get the empty list, and in [core.command] + you get an error. *) Arg_test.eval_all (test ()) { prog = "test"; args = [ "--who"; "" ] }; [%expect {| @@ -255,6 +314,8 @@ let%expect_test "named_with_default__comma_separated" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse --who value \\\"\\\".\\n(Failure \\\"Command.Spec.Arg_type.comma_separated: empty list not allowed\\\")\")")) + ----------------------------------------------------- Stdlib_runner + Hello |}]; Arg_test.eval_all (test ()) { prog = "test"; args = [ "--who"; "Universe,Them Too" ] }; [%expect @@ -268,6 +329,9 @@ let%expect_test "named_with_default__comma_separated" = ----------------------------------------------------- Core_command Hello Universe Hello Them Too + ----------------------------------------------------- Stdlib_runner + Hello Universe + Hello Them Too |}]; () ;; diff --git a/test/expect/test__negative_int_args.ml b/test/expect/test__negative_int_args.ml index 26865dc..b97f60b 100644 --- a/test/expect/test__negative_int_args.ml +++ b/test/expect/test__negative_int_args.ml @@ -22,6 +22,8 @@ let%expect_test "negative positional" = zero ----------------------------------------------------- Core_command zero + ----------------------------------------------------- Stdlib_runner + zero |}]; Arg_test.eval_all test { prog = "test"; args = [ "+1" ] }; [%expect @@ -32,8 +34,10 @@ let%expect_test "negative positional" = positive ----------------------------------------------------- Core_command positive + ----------------------------------------------------- Stdlib_runner + positive |}]; - (* All three backend agree, negative numbers are not supported as positional + (* All backends agree, negative numbers are not supported as positional arguments, because they look like flags. *) Arg_test.eval_all test { prog = "test"; args = [ "-1" ] }; [%expect @@ -48,6 +52,19 @@ let%expect_test "negative positional" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"unknown flag -1\")")) + ----------------------------------------------------- Stdlib_runner + test: unknown option '-1'. + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + an integer (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -74,6 +91,8 @@ let%expect_test "negative named" = zero ----------------------------------------------------- Core_command zero + ----------------------------------------------------- Stdlib_runner + zero |}]; Arg_test.eval_all test { prog = "test"; args = [ "-n"; "+1" ] }; [%expect @@ -84,9 +103,10 @@ let%expect_test "negative named" = positive ----------------------------------------------------- Core_command positive + ----------------------------------------------------- Stdlib_runner + positive |}]; - (* When the arg is named, climate and core.command support negative values, - but cmdliner does not. *) + (* When the arg is named, cmdliner does not support negative values. *) Arg_test.eval_all test { prog = "test"; args = [ "-n"; "-1" ] }; [%expect {| @@ -99,6 +119,8 @@ let%expect_test "negative named" = ("Evaluation Failed" ((exit_code 124))) ----------------------------------------------------- Core_command negative + ----------------------------------------------------- Stdlib_runner + negative |}]; () ;; diff --git a/test/expect/test__param.ml b/test/expect/test__param.ml index 7c16bf3..581087a 100644 --- a/test/expect/test__param.ml +++ b/test/expect/test__param.ml @@ -17,6 +17,8 @@ let%expect_test "string" = hello ----------------------------------------------------- Core_command hello + ----------------------------------------------------- Stdlib_runner + hello |}]; () ;; @@ -32,6 +34,8 @@ let%expect_test "int" = 1_234 ----------------------------------------------------- Core_command 1_234 + ----------------------------------------------------- Stdlib_runner + 1_234 |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "not-an-int" ] }; [%expect @@ -48,6 +52,19 @@ let%expect_test "int" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse INT value \\\"not-an-int\\\"\\n(Failure \\\"Int.of_string: \\\\\\\"not-an-int\\\\\\\"\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid value "not-an-int" (not an int). + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -63,6 +80,8 @@ let%expect_test "float" = 1234. ----------------------------------------------------- Core_command 1234. + ----------------------------------------------------- Stdlib_runner + 1234. |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "1.234" ] }; [%expect @@ -73,6 +92,8 @@ let%expect_test "float" = 1.234 ----------------------------------------------------- Core_command 1.234 + ----------------------------------------------------- Stdlib_runner + 1.234 |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "not-an-number" ] }; [%expect @@ -90,6 +111,19 @@ let%expect_test "float" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse FLOAT value \\\"not-an-number\\\"\\n(Invalid_argument \\\"Float.of_string not-an-number\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid value "not-an-number" (not a float). + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -105,6 +139,8 @@ let%expect_test "bool" = true ----------------------------------------------------- Core_command true + ----------------------------------------------------- Stdlib_runner + true |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "false" ] }; [%expect @@ -115,6 +151,8 @@ let%expect_test "bool" = false ----------------------------------------------------- Core_command false + ----------------------------------------------------- Stdlib_runner + false |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "not-a-bool" ] }; [%expect @@ -131,6 +169,19 @@ let%expect_test "bool" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse BOOL value \\\"not-a-bool\\\"\\n(Failure \\\"valid arguments: {false,true}\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid value "not-a-bool" (not a bool). + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -155,6 +206,8 @@ let%expect_test "file" = ("Evaluation Failed" ((exit_code 124))) ----------------------------------------------------- Core_command foo.txt + ----------------------------------------------------- Stdlib_runner + foo.txt |}]; save_file ~path:"foo.txt" ~contents:"Foo"; Arg_test.eval_all t1 { prog = "test"; args = [ "foo.txt" ] }; @@ -166,61 +219,11 @@ let%expect_test "file" = foo.txt ----------------------------------------------------- Core_command foo.txt + ----------------------------------------------------- Stdlib_runner + foo.txt |}] ;; -let%expect_test "assoc" = - let module E = struct - type t = - | A - | B - [@@deriving enumerate, sexp_of] - - let to_string t = Sexp.to_string (sexp_of_t t) - end - in - let t1 = - test (Command.Param.assoc (List.map E.all ~f:(fun e -> E.to_string e, e))) E.to_string - in - Arg_test.eval_all t1 { prog = "test"; args = [ "A" ] }; - [%expect - {| - ----------------------------------------------------- Climate - A - ----------------------------------------------------- Cmdliner - A - ----------------------------------------------------- Core_command - A - |}]; - Arg_test.eval_all t1 { prog = "test"; args = [ "B" ] }; - [%expect - {| - ----------------------------------------------------- Climate - B - ----------------------------------------------------- Cmdliner - B - ----------------------------------------------------- Core_command - B - |}]; - Arg_test.eval_all t1 { prog = "test"; args = [ "Not_an_e" ] }; - [%expect - {| - ----------------------------------------------------- Climate - ("Evaluation Raised" ( - Climate.Parse_error.E - "Failed to parse the argument at position 0: invalid value: \"Not_an_e\" (valid values are: A, B)")) - ----------------------------------------------------- Cmdliner - test: invalid value 'Not_an_e', expected either 'A' or 'B' - Usage: test [OPTION]… ARG - Try 'test --help' for more information. - ("Evaluation Failed" ((exit_code 124))) - ----------------------------------------------------- Core_command - ("Evaluation Failed" ( - "Command.Failed_to_parse_command_line(\"failed to parse VAL value \\\"Not_an_e\\\"\\n(Failure \\\"valid arguments: {A,B}\\\")\")")) - |}]; - () -;; - let%expect_test "enumerated" = let module E = struct type t = @@ -244,6 +247,8 @@ let%expect_test "enumerated" = A ----------------------------------------------------- Core_command A + ----------------------------------------------------- Stdlib_runner + A |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "B" ] }; [%expect @@ -254,6 +259,8 @@ let%expect_test "enumerated" = B ----------------------------------------------------- Core_command B + ----------------------------------------------------- Stdlib_runner + B |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "Not_an_e" ] }; [%expect @@ -270,6 +277,19 @@ let%expect_test "enumerated" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse VAL value \\\"Not_an_e\\\"\\n(Failure \\\"valid arguments: {A,B}\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid value "Not_an_e" (not a valid choice). + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -297,6 +317,8 @@ let%expect_test "stringable" = my-id ----------------------------------------------------- Core_command my-id + ----------------------------------------------------- Stdlib_runner + my-id |}]; () ;; @@ -332,6 +354,8 @@ let%expect_test "validated_string" = A ----------------------------------------------------- Core_command A + ----------------------------------------------------- Stdlib_runner + A |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "B" ] }; [%expect @@ -342,6 +366,8 @@ let%expect_test "validated_string" = B ----------------------------------------------------- Core_command B + ----------------------------------------------------- Stdlib_runner + B |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "Id_size8" ] }; [%expect @@ -352,6 +378,8 @@ let%expect_test "validated_string" = Id_size8 ----------------------------------------------------- Core_command Id_size8 + ----------------------------------------------------- Stdlib_runner + Id_size8 |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "Id_of_size12" ] }; [%expect @@ -368,6 +396,19 @@ let%expect_test "validated_string" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse VAL value \\\"Id_of_size12\\\"\\n(Msg \\\"invalid id\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid id. + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -399,6 +440,8 @@ let%expect_test "comma_separated" = A ----------------------------------------------------- Core_command A + ----------------------------------------------------- Stdlib_runner + A |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "B" ] }; [%expect @@ -409,6 +452,8 @@ let%expect_test "comma_separated" = B ----------------------------------------------------- Core_command B + ----------------------------------------------------- Stdlib_runner + B |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "A,B" ] }; [%expect @@ -419,6 +464,8 @@ let%expect_test "comma_separated" = A,B ----------------------------------------------------- Core_command A,B + ----------------------------------------------------- Stdlib_runner + A,B |}]; (* At the moment the translation does not consistently determine whether the empty list is accepted. This is arguably a bug/limitation of the current @@ -435,6 +482,19 @@ let%expect_test "comma_separated" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse VAL value \\\"\\\"\\n(Failure \\\"Command.Spec.Arg_type.comma_separated: empty list not allowed\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid value "" (not a valid choice). + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; Arg_test.eval_all t1 { prog = "test"; args = [ "Not_an_e" ] }; [%expect @@ -452,6 +512,19 @@ let%expect_test "comma_separated" = ----------------------------------------------------- Core_command ("Evaluation Failed" ( "Command.Failed_to_parse_command_line(\"failed to parse VAL value \\\"Not_an_e\\\"\\n(Failure \\\"valid arguments: {A,B}\\\")\")")) + ----------------------------------------------------- Stdlib_runner + test: Failed to parse the argument at position 0: invalid value "Not_an_e" (not a valid choice). + Usage: test [OPTIONS] [ARGUMENTS] + + eval-stdlib-runner + + Arguments: + param (required) + + Options: + -help Display this list of options + --help Display this list of options + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; diff --git a/test/expect/test__pos.ml b/test/expect/test__pos.ml index 6665e7f..85c0aac 100644 --- a/test/expect/test__pos.ml +++ b/test/expect/test__pos.ml @@ -21,6 +21,9 @@ let%expect_test "pos" = ("Evaluation Failed" ((exit_code 124))) ----------------------------------------------------- Core_command ("Evaluation Failed" "missing anonymous argument: WHO") + ----------------------------------------------------- Stdlib_runner + Missing required positional argument at position 0. + ("Evaluation Failed" ((exit_code 2))) |}]; Arg_test.eval_all test { prog = "test"; args = [ "World" ] }; [%expect @@ -31,6 +34,8 @@ let%expect_test "pos" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; () ;; @@ -63,6 +68,12 @@ let%expect_test "skipping-pos" = "Positional arguments must be supplied in consecutive order" ((expected 0) (got 1)))) + ----------------------------------------------------- Stdlib_runner + Invalid command specification (programming error): + + Attempted to declare a parser with a gap in its positional arguments. + Positional argument 0 is missing. + ("Evaluation Failed" ((exit_code 2))) |}]; Arg_test.eval_all test { prog = "test"; args = [ "World" ] }; [%expect @@ -81,6 +92,12 @@ let%expect_test "skipping-pos" = "Positional arguments must be supplied in consecutive order" ((expected 0) (got 1)))) + ----------------------------------------------------- Stdlib_runner + Invalid command specification (programming error): + + Attempted to declare a parser with a gap in its positional arguments. + Positional argument 0 is missing. + ("Evaluation Failed" ((exit_code 2))) |}]; Arg_test.eval_all test { prog = "test"; args = [ "Big"; "World" ] }; [%expect @@ -96,6 +113,12 @@ let%expect_test "skipping-pos" = "Positional arguments must be supplied in consecutive order" ((expected 0) (got 1)))) + ----------------------------------------------------- Stdlib_runner + Invalid command specification (programming error): + + Attempted to declare a parser with a gap in its positional arguments. + Positional argument 0 is missing. + ("Evaluation Failed" ((exit_code 2))) |}]; () ;; @@ -114,6 +137,7 @@ let%expect_test "pos_opt" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; Arg_test.eval_all test { prog = "test"; args = [ "World" ] }; [%expect @@ -124,6 +148,8 @@ let%expect_test "pos_opt" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; () ;; @@ -150,6 +176,8 @@ let%expect_test "pos_with_default" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; Arg_test.eval_all test { prog = "test"; args = [ "You" ] }; [%expect @@ -160,6 +188,8 @@ let%expect_test "pos_with_default" = Hello You ----------------------------------------------------- Core_command Hello You + ----------------------------------------------------- Stdlib_runner + Hello You |}]; () ;; @@ -178,6 +208,7 @@ let%expect_test "pos_all" = ----------------------------------------------------- Climate ----------------------------------------------------- Cmdliner ----------------------------------------------------- Core_command + ----------------------------------------------------- Stdlib_runner |}]; Arg_test.eval_all test { prog = "test"; args = [ "World" ] }; [%expect @@ -188,6 +219,8 @@ let%expect_test "pos_all" = Hello World ----------------------------------------------------- Core_command Hello World + ----------------------------------------------------- Stdlib_runner + Hello World |}]; Arg_test.eval_all test { prog = "test"; args = [ "World"; "You"; "Me" ] }; [%expect @@ -204,6 +237,10 @@ let%expect_test "pos_all" = Hello World Hello You Hello Me + ----------------------------------------------------- Stdlib_runner + Hello World + Hello You + Hello Me |}]; () ;; From 5b4fce36123e732f8a2ed3d99327ae1009e93075 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Nov 2024 23:20:36 +0100 Subject: [PATCH 7/7] Update doc and changelog for stdlib.arg --- CHANGES.md | 16 ++++++++++++++++ README.md | 3 +++ doc/docs/explanation/future_plans.md | 7 +++++++ 3 files changed, 26 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index bdab018..ba98f85 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,19 @@ +## 0.0.8 (unreleased) + +### Added + +- Add a new backend based on `stdlib.arg`. + +### Changed + +### Deprecated + +### Fixed + +### Removed + +- Remove `Param.assoc`. We require now the `to_string` function found in `Enums`. + ## 0.0.7 (2024-11-10) ### Removed diff --git a/README.md b/README.md index efddd15..7f61bf1 100644 --- a/README.md +++ b/README.md @@ -77,6 +77,9 @@ We initiated the library as part of another project where we are migrating some - Convert `cmdlang` parsers at runtime into `cmdliner`, `core.command`, or `climate` parsers - Packaged as separate helper libraries to keep dependencies isolated. +4. **Basic execution runner based on stdlib.arg**: + - A proof-of-concept execution engine implemented on top of `stdlib.arg`. + ## Experimental Status `cmdlang` is currently under construction and considered experimental. We are actively seeking feedback to validate our design and engage with other declarative command-line enthusiasts. diff --git a/doc/docs/explanation/future_plans.md b/doc/docs/explanation/future_plans.md index 4befa36..82b5775 100644 --- a/doc/docs/explanation/future_plans.md +++ b/doc/docs/explanation/future_plans.md @@ -15,6 +15,13 @@ However, we have a good intuition that by reducing some of the expressiveness of - [x] Develop a strategy for translating positional arguments in `core.command` (Completed: Aug 2024) - [x] Implement left-to-right order enforcement for positional arguments when compiling to `core.command` (Completed: Aug 2024) +## Targeting stdlib.arg as a runner + +We'd like to write a mini-compiler targeting `stdlib.arg` as a proof-of-concept showing that it is possible to implement an execution runner for cmdlang that reuses the parsing engine implemented in the standard library. + +### Tasks +- [x] Implemented an execution engine for cmdlang based on `stdlib.arg` (Completed: Nov 2024) + ## Generation of Complex Man Pages Another area of focus is the generation of complex man pages. `cmdliner` has excellent support for these. Currently, we have added basic support for one-line summaries of help messages to get started. However, we believe we could reuse most of the design of `cmdliner` and add it as optional information to the specification language.