Skip to content

Commit 6f29ca8

Browse files
bobzhangbobzhang
authored
Merge pull request #4455 from BuckleScript/simplify_commandline_parsing
simplify command line parsing, prepare our own command line parser in the future
2 parents 81be60a + 8a3bdc9 commit 6f29ca8

File tree

4 files changed

+209
-298
lines changed

4 files changed

+209
-298
lines changed

‎jscomp/bsb_helper/bsb_helper_arg.ml‎

Lines changed: 63 additions & 109 deletions
Original file line numberDiff line numberDiff line change
@@ -1,153 +1,107 @@
11

22
type key = string
33
type doc = string
4-
type usage_msg = string
5-
type anon_fun = (string -> unit)
4+
type anon_fun = rev_args:string list -> unit
5+
6+
type string_action =
7+
| Call of (string -> unit)
8+
| Set of {mutable contents : string}
69

710
type spec =
8-
| Unit of (unit -> unit)
9-
| Set of bool ref
10-
| String of (string -> unit)
11-
| Set_string of string ref
12-
| Int of (int -> unit)
13-
| Set_int of int ref
11+
| Bool of bool ref
12+
| String of string_action
13+
1414

1515
exception Bad of string
16-
(* exception Help of string *)
16+
1717

1818
type error =
1919
| Unknown of string
20-
| Wrong of string * string * string (* option, actual, expected *)
2120
| Missing of string
22-
| Message of string
23-
24-
exception Stop of error
25-
2621

2722
type t = (string * spec * string) list
2823

2924
let rec assoc3 (x : string) (l : t) =
3025
match l with
3126
| [] -> None
32-
| (y1, y2, _y3) :: _t when y1 = x -> Some y2
27+
| (y1, y2, _) :: _ when y1 = x -> Some y2
3328
| _ :: t -> assoc3 x t
3429
;;
3530

3631

37-
38-
let usage_b (buf : Ext_buffer.t) speclist errmsg =
39-
let print_spec buf (key, _spec, doc) =
40-
if doc <> "" then begin
41-
Ext_buffer.add_string buf " ";
42-
Ext_buffer.add_string_char buf key ' ';
43-
Ext_buffer.add_string_char buf doc '\n'
44-
end
45-
in
46-
47-
Ext_buffer.add_string_char buf errmsg '\n';
48-
Ext_list.iter speclist (print_spec buf)
32+
let (+>) = Ext_buffer.add_string
33+
34+
let usage_b (buf : Ext_buffer.t) progname speclist =
35+
buf +> progname;
36+
buf +> " options:\n";
37+
let max_col = ref 0 in
38+
Ext_list.iter speclist (fun (key,_,_) ->
39+
if String.length key > !max_col then
40+
max_col := String.length key
41+
);
42+
Ext_list.iter speclist (fun (key,_,doc) ->
43+
buf +> " ";
44+
buf +> key ;
45+
buf +> (String.make (!max_col - String.length key + 1 ) ' ');
46+
buf +> doc;
47+
buf +> "\n"
48+
)
4949
;;
5050

5151

5252

53-
let stop_raise progname (error : error) speclist errmsg =
53+
let stop_raise ~progname ~(error : error) speclist =
5454
let b = Ext_buffer.create 200 in
5555
begin match error with
5656
| Unknown ("-help" | "--help" | "-h") ->
57-
usage_b b speclist errmsg;
58-
output_string stdout (Ext_buffer.contents b);
59-
exit 0
60-
57+
usage_b b progname speclist ;
58+
Ext_buffer.output_buffer stdout b;
59+
exit 0
6160
| Unknown s ->
62-
Ext_buffer.add_string_char b progname ':';
63-
Ext_buffer.add_string b " unknown option '";
64-
Ext_buffer.add_string b s ;
65-
Ext_buffer.add_string b "'.\n"
61+
b +> progname ;
62+
b +> ": unknown option '";
63+
b +> s ;
64+
b +> "'.\n"
6665
| Missing s ->
67-
Ext_buffer.add_string_char b progname ':';
68-
Ext_buffer.add_string b " option '";
69-
Ext_buffer.add_string b s;
70-
Ext_buffer.add_string b "' needs an argument.\n"
71-
| Wrong (opt, arg, expected) ->
72-
Ext_buffer.add_string_char b progname ':';
73-
Ext_buffer.add_string b " wrong argument '";
74-
Ext_buffer.add_string b arg;
75-
Ext_buffer.add_string b "'; option '";
76-
Ext_buffer.add_string b opt;
77-
Ext_buffer.add_string b "' expects ";
78-
Ext_buffer.add_string b expected;
79-
Ext_buffer.add_string b ".\n"
80-
| Message s ->
81-
Ext_buffer.add_string_char b progname ':';
82-
Ext_buffer.add_char_string b ' ' s;
83-
Ext_buffer.add_string b ".\n"
66+
b +> progname ;
67+
b +> ": option '";
68+
b +> s;
69+
b +> "' needs an argument.\n"
8470
end;
85-
usage_b b speclist errmsg;
71+
usage_b b progname speclist ;
8672
raise (Bad (Ext_buffer.contents b))
8773

8874

89-
let parse_exn (speclist : t) anonfun errmsg =
90-
let argv = Sys.argv in
91-
let stop_raise error = stop_raise argv.(0) error speclist errmsg in
75+
let parse_exn ~progname ~argv ~start (speclist : t) anonfun =
9276
let l = Array.length argv in
93-
let current = ref 1 in (* 0 is progname*)
77+
let current = ref start in
78+
let rev_list = ref [] in
9479
while !current < l do
9580
let s = argv.(!current) in
81+
incr current;
9682
if s <> "" && s.[0] = '-' then begin
97-
let action =
98-
match assoc3 s speclist with
99-
| Some action -> action
100-
| None -> stop_raise (Unknown s)
101-
in
102-
begin try
103-
let treat_action = function
104-
| Unit f -> f ();
105-
| Set r -> r := true;
106-
| String f when !current + 1 < l ->
107-
f argv.(!current + 1);
108-
incr current;
109-
| Set_string r when !current + 1 < l ->
110-
r := argv.(!current + 1);
111-
incr current;
112-
| Int f when !current + 1 < l ->
113-
let arg = argv.(!current + 1) in
114-
begin match int_of_string arg with
115-
| i -> f i
116-
| exception _
117-
->
118-
raise (Stop (Wrong (s, arg, "an integer")))
119-
end;
120-
incr current;
121-
| Set_int r when !current + 1 < l ->
122-
let arg = argv.(!current + 1) in
123-
r := (try int_of_string arg
124-
with _ ->
125-
raise (Stop (Wrong (s, arg, "an integer")))
126-
);
127-
incr current;
128-
| _ -> raise (Stop (Missing s))
129-
in
130-
treat_action action
131-
with Bad m -> stop_raise (Message m);
132-
| Stop e -> stop_raise e;
133-
end;
134-
incr current;
83+
match assoc3 s speclist with
84+
| Some action -> begin
85+
begin match action with
86+
| Bool r -> r := true;
87+
| String f ->
88+
if !current >= l then stop_raise ~progname ~error:(Missing s) speclist
89+
else begin
90+
let arg = argv.(!current) in
91+
incr current;
92+
match f with
93+
| Call f ->
94+
f arg
95+
| Set u -> u.contents <- arg
96+
end
97+
end;
98+
end;
99+
| None -> stop_raise ~progname ~error:(Unknown s) speclist
135100
end else begin
136-
(try anonfun s with Bad m -> stop_raise (Message m));
137-
incr current;
101+
rev_list := s :: !rev_list;
138102
end;
139103
done;
104+
anonfun ~rev_args:!rev_list
140105
;;
141106

142107

143-
144-
(* let parse l f msg =
145-
try
146-
parse_exn l f msg;
147-
with
148-
| Bad msg ->
149-
output_string stderr msg ; exit 2;
150-
| Help msg ->
151-
output_string stdout msg; exit 0;
152-
;;
153-
*)

‎jscomp/bsb_helper/bsb_helper_arg.mli‎

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,25 @@
11

22

33

4+
type string_action =
5+
| Call of (string -> unit)
6+
| Set of {mutable contents : string}
7+
48
type spec =
5-
| Unit of (unit -> unit)
6-
| Set of bool ref
7-
| String of (string -> unit)
8-
| Set_string of string ref
9-
| Int of (int -> unit)
10-
| Set_int of int ref
9+
| Bool of bool ref
10+
| String of string_action
1111

1212
type key = string
1313
type doc = string
14-
type usage_msg = string
15-
type anon_fun = (string -> unit)
14+
15+
type anon_fun = rev_args:string list -> unit
1616

1717
val parse_exn :
18-
(key * spec * doc) list -> anon_fun -> usage_msg -> unit
18+
progname:string ->
19+
argv:string array ->
20+
start:int ->
21+
(key * spec * doc) list ->
22+
anon_fun -> unit
1923

2024

2125

‎jscomp/main/bsb_helper_main.ml‎

Lines changed: 29 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -23,42 +23,40 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424
let compilation_kind = ref Bsb_helper_depfile_gen.Js
2525

26-
let hash : string ref = ref ""
27-
let batch_files = ref []
28-
let collect_file name =
29-
batch_files := name :: !batch_files
26+
let hash : Bsb_helper_arg.string_action =
27+
Set {contents = ""}
3028

31-
(* let output_prefix = ref None *)
3229
let dev_group = ref false
3330
let namespace = ref None
34-
35-
36-
let anonymous filename =
37-
collect_file filename
38-
let usage = "Usage: bsb_helper.exe [options] \nOptions are:"
3931

4032
let () =
41-
Bsb_helper_arg.parse_exn [
42-
"-g", Set dev_group ,
43-
" Set the dev group (default to be 0)"
33+
Bsb_helper_arg.parse_exn
34+
~progname:Sys.argv.(0)
35+
~argv:Sys.argv
36+
~start:1
37+
[
38+
"-g", Bool dev_group ,
39+
"Set the dev group (default to be 0)"
4440
;
45-
"-bs-ns", String (fun s -> namespace := Some s),
46-
" Set namespace";
47-
"-hash", Set_string hash,
48-
" Set hash(internal)";
49-
] anonymous usage;
50-
(* arrange with mlast comes first *)
51-
match !batch_files with
52-
| [x]
53-
-> Bsb_helper_depfile_gen.emit_d
41+
"-bs-ns", String (Call (fun s -> namespace := Some s)),
42+
"Set namespace";
43+
"-hash", String hash,
44+
"Set hash(internal)";
45+
] (fun ~rev_args ->
46+
match rev_args with
47+
| [x]
48+
-> Bsb_helper_depfile_gen.emit_d
49+
!compilation_kind
50+
!dev_group
51+
!namespace x ""
52+
| [y; x] (* reverse order *)
53+
->
54+
Bsb_helper_depfile_gen.emit_d
5455
!compilation_kind
5556
!dev_group
56-
!namespace x ""
57-
| [y; x] (* reverse order *)
58-
->
59-
Bsb_helper_depfile_gen.emit_d
60-
!compilation_kind
61-
!dev_group
62-
!namespace x y
63-
| _ ->
64-
()
57+
!namespace x y
58+
| _ ->
59+
()
60+
) ;
61+
(* arrange with mlast comes first *)
62+

0 commit comments

Comments
 (0)