From f013a3c0e23b6a1e8dc82696b1d1e5323cdd62e5 Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Mon, 24 Apr 2023 11:05:12 +0200
Subject: [PATCH 1/2] Clic: allow param and stop at same level

This allows, e.g., to define 2 commands:
- run --option1 --option2
- run <param> with --option1 ...

Fixes #5475
---
 src/lib_clic/tezos_clic.ml | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/src/lib_clic/tezos_clic.ml b/src/lib_clic/tezos_clic.ml
index e258bd1dff45..783a273270d3 100644
--- a/src/lib_clic/tezos_clic.ml
+++ b/src/lib_clic/tezos_clic.ml
@@ -1197,9 +1197,6 @@ and 'ctx tree =
   | TNonTerminalSeq : 'ctx non_terminal_seq_level -> 'ctx tree
   | TEmpty : 'ctx tree
 
-let has_options : type ctx. ctx command -> bool =
- fun (Command {options; _}) -> has_args options
-
 let insert_in_dispatch_tree : type ctx. ctx tree -> ctx command -> ctx tree =
  fun root (Command {params; conv; _} as command) ->
   let rec insert_tree :
@@ -1230,9 +1227,7 @@ let insert_in_dispatch_tree : type ctx. ctx tree -> ctx command -> ctx tree =
         TPrefix {stop = None; prefix = [(n, insert_tree TEmpty next)]}
     | TStop cmd, Param (_, _, {autocomplete; _}, next) ->
         let autocomplete = conv_autocomplete autocomplete in
-        if not (has_options cmd) then
-          TParam {tree = insert_tree TEmpty next; stop = Some cmd; autocomplete}
-        else Stdlib.failwith "Command cannot have both prefix and options"
+        TParam {tree = insert_tree TEmpty next; stop = Some cmd; autocomplete}
     | TStop cmd, Prefix (n, next) ->
         TPrefix {stop = Some cmd; prefix = [(n, insert_tree TEmpty next)]}
     | TStop cmd, NonTerminalSeq (name, desc, {autocomplete; _}, suffix, next) ->
@@ -1297,6 +1292,13 @@ and gather_assoc ?(acc = []) trees =
 
 let find_command tree initial_arguments =
   let open Lwt_result_syntax in
+  let is_short_option s =
+    String.length s = 2
+    && s.[0] = '-'
+    && match s.[1] with 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
+  in
+  let is_long_option s = String.length s >= 2 && s.[0] = '-' && s.[1] = '-' in
+  let is_option s = is_short_option s || is_long_option s in
   let rec traverse tree arguments acc =
     match (tree, arguments) with
     | ( ( TStop _ | TSeq _
@@ -1362,6 +1364,10 @@ let find_command tree initial_arguments =
         | Some tree' -> traverse tree' tl (hd_arg :: acc))
     | TParam {stop = None; _}, ([] | ("-h" | "--help") :: _) ->
         tzfail (Unterminated_command (initial_arguments, gather_commands tree))
+    | TParam {stop = Some c; _}, hd :: _ when is_option hd ->
+        (* If the argument looks like an option, we choose the "stop"
+           command. *)
+        traverse (TStop c) arguments acc
     | TParam {stop = Some c; _}, [] ->
         return (c, empty_args_dict, initial_arguments)
     | TParam {tree; _}, parameter :: arguments' ->
-- 
GitLab


From 70d3859412bc4130fe9bdca9fba618c48f791a0d Mon Sep 17 00:00:00 2001
From: Alain Mebsout <alain.mebsout@functori.com>
Date: Mon, 24 Apr 2023 15:51:52 +0200
Subject: [PATCH 2/2] Test: test Clic dispatch on param/stop with option

---
 src/lib_clic/test/test_clic.ml | 38 +++++++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

diff --git a/src/lib_clic/test/test_clic.ml b/src/lib_clic/test/test_clic.ml
index 90244842ea28..578c3267b0ab 100644
--- a/src/lib_clic/test/test_clic.ml
+++ b/src/lib_clic/test/test_clic.ml
@@ -79,6 +79,12 @@ let abcd_param ~name =
 let efgh_param ~name =
   Tezos_clic.param ~name ~desc:"must be E,F,G,H, or \"end\"" efgh_parameter
 
+let neg_param ~name =
+  Tezos_clic.param ~name ~desc:"must be negative number"
+  @@ Tezos_clic.parameter (fun _ w ->
+         let i = int_of_string w in
+         if i >= 0 then failwith "must be negative" else Lwt_result.return i)
+
 (* instrumentation *)
 
 let dispatch cmds argv () =
@@ -226,6 +232,21 @@ let test_dispatch_advanced () =
       (fun () l () ->
         return ("F" ^ String.concat "" (List.map string_of_abcd l)))
   in
+  let enp_neg_1 return =
+    Tezos_clic.command
+      ~desc:"neg-param"
+      Tezos_clic.no_options
+      (Tezos_clic.prefixes ["the"; "start"]
+      @@ neg_param ~name:"neg" @@ Tezos_clic.prefix "done" @@ Tezos_clic.stop)
+      (fun () i () -> return ("E" ^ string_of_int i))
+  in
+  let enp_prefix_stop return =
+    Tezos_clic.command
+      ~desc:"strict-prefix"
+      Tezos_clic.(args1 @@ switch ~doc:"" ~long:"nothing" ())
+      (Tezos_clic.prefixes ["the"; "start"] @@ Tezos_clic.stop)
+      (fun nothing () -> return (Printf.sprintf "E-%b" nothing))
+  in
   let expect line = expect_result line Format.pp_print_string in
   let open Lwt_syntax in
   let* () =
@@ -325,7 +346,22 @@ let test_dispatch_advanced () =
   let* () =
     expect __LINE__ expected_error (dispatch [en; fr] ["a"; "la"; "fin"])
   in
-  expect __LINE__ expected_error (dispatch [fr; en] ["a"; "la"; "fin"])
+  let* () =
+    expect __LINE__ expected_error (dispatch [fr; en] ["a"; "la"; "fin"])
+  in
+  let* () =
+    expect
+      __LINE__
+      (Ok "E-1")
+      (dispatch [enp_prefix_stop; enp_neg_1] ["the"; "start"; "-1"; "done"])
+  in
+  let* () =
+    expect
+      __LINE__
+      (Ok "E-true")
+      (dispatch [enp_prefix_stop; enp_neg_1] ["the"; "start"; "--nothing"])
+  in
+  return_unit
 
 let string_param ~autocomplete next =
   Tezos_clic.(
-- 
GitLab