Skip to content

Commit 5e1f192

Browse files
authored
Use Cmdliner in gen_api_main.ml (#6319)
- Drops usage of stdlib `Arg` module for argument parsing, replacing it with Cmdliner. - Drops some globals pertaining to the filtering of APIs. - Drops apparent condition in `Gen_server`: `server.ml` cannot be built without the debug flag being enabled, as the emitted OCaml code is ill formed. - Drops ability to specify an output file; dune's `with-stdout-to` subsumes this behaviour, as does the piping functionality in every shell. The idea is hopefully that it'll be more flexible to experiment and extend the `ocaml_backend/` targets.
2 parents 8e48cb2 + 72ab979 commit 5e1f192

24 files changed

+241
-232
lines changed

ocaml/idl/datamodel_main.ml

Lines changed: 11 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -48,17 +48,15 @@ let _ =
4848
if num_modes_set > 1 then failwith "More than one mode on the commandline" ;
4949

5050
let oss_filter api =
51-
filter
52-
(fun _ -> true)
53-
(fun field -> List.mem "3.0.3" field.release.opensource)
54-
(fun message -> List.mem "3.0.3" message.msg_release.opensource)
51+
filter_by
52+
~field:(fun field -> List.mem "3.0.3" field.release.opensource)
53+
~message:(fun message -> List.mem "3.0.3" message.msg_release.opensource)
5554
api
5655
in
5756
let closed_filter api =
58-
filter
59-
(fun _ -> true)
60-
(fun field -> List.mem "closed" field.release.internal)
61-
(fun message -> List.mem "closed" message.msg_release.internal)
57+
filter_by
58+
~field:(fun field -> List.mem "closed" field.release.internal)
59+
~message:(fun message -> List.mem "closed" message.msg_release.internal)
6260
api
6361
in
6462

@@ -75,13 +73,12 @@ let _ =
7573
(* Add all implicit messages to the API directly *)
7674
let api = DU.add_implicit_messages ~document_order:!markdown_mode api in
7775
(* Only show those visible to the client *)
78-
let api = filter (fun _ -> true) (Fun.const true) DU.on_client_side api in
76+
let api = filter_by ~message:DU.on_client_side api in
7977
(* And only messages marked as not hidden from the docs, and non-internal fields *)
8078
let api =
81-
filter
82-
(fun _ -> true)
83-
(fun f -> not f.internal_only)
84-
(fun m -> not m.msg_hide_from_docs)
79+
filter_by
80+
~field:(fun f -> not f.internal_only)
81+
~message:(fun m -> not m.msg_hide_from_docs)
8582
api
8683
in
8784

@@ -94,10 +91,6 @@ let _ =
9491

9592
if !dtd_mode then
9693
let api =
97-
filter
98-
(fun _ -> true)
99-
(fun field -> field.qualifier <> DynamicRO)
100-
(fun _ -> true)
101-
api
94+
filter_by ~field:(fun field -> field.qualifier <> DynamicRO) api
10295
in
10396
List.iter print_endline (Dtd_backend.of_objs api)

ocaml/idl/dm_api.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,10 @@ let filter (obj : obj -> bool) (field : field -> bool)
156156
in
157157
rebuild system relations
158158

159+
let filter_by ?(obj = fun _ -> true) ?(field = fun _ -> true)
160+
?(message = fun _ -> true) =
161+
filter obj field message
162+
159163
let map (obj : obj -> obj) (field : string -> field -> field)
160164
(message : message -> message) ((system, relations) : api) : api =
161165
let system =

ocaml/idl/dm_api.mli

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,8 +34,14 @@ val get_obj_by_name : api -> objname:string -> obj
3434
val field_exists : api -> objname:string -> fieldname:string -> bool
3535
(** True if the named field exists *)
3636

37-
val filter : (obj -> bool) -> (field -> bool) -> (message -> bool) -> api -> api
38-
(** Apply a predicate to every object, field and message, to generate a sub-API *)
37+
val filter_by :
38+
?obj:(obj -> bool)
39+
-> ?field:(field -> bool)
40+
-> ?message:(message -> bool)
41+
-> api
42+
-> api
43+
(** Filter an API by filtering objects, fields, and messages. The
44+
default predicates retain everything. *)
3945

4046
val map :
4147
(obj -> obj)

ocaml/idl/json_backend/gen_json.ml

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -687,13 +687,12 @@ let () =
687687
(* Add all implicit messages *)
688688
let api = add_implicit_messages api in
689689
(* Only include messages that are visible to a XenAPI client *)
690-
let api = filter (fun _ -> true) (fun _ -> true) on_client_side api in
690+
let api = filter_by ~message:on_client_side api in
691691
(* And only messages marked as not hidden from the docs, and non-internal fields *)
692692
let api =
693-
filter
694-
(fun _ -> true)
695-
(fun f -> not f.internal_only)
696-
(fun m -> not m.msg_hide_from_docs)
693+
filter_by
694+
~field:(fun f -> not f.internal_only)
695+
~message:(fun m -> not m.msg_hide_from_docs)
697696
api
698697
in
699698
let objs = objects_of_api api in

ocaml/idl/markdown_backend.ml

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -528,10 +528,8 @@ let generate_errors () =
528528
let all api =
529529
(* Remove private messages that are only used internally (e.g. get_record_internal) *)
530530
let api =
531-
Dm_api.filter
532-
(fun _ -> true)
533-
(fun _ -> true)
534-
(fun msg ->
531+
Dm_api.filter_by
532+
~message:(fun msg ->
535533
match msg.msg_tag with FromObject (Private _) -> false | _ -> true
536534
)
537535
api

ocaml/idl/ocaml_backend/dune

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
(name gen_api_main)
44
(libraries
55
astring
6+
cmdliner
67
uuidm
78
xapi-consts
89
xapi-datamodel

ocaml/idl/ocaml_backend/gen_api.ml

Lines changed: 9 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -260,7 +260,7 @@ let gen_record_type ~with_module highapi tys =
260260
in
261261
aux [] tys
262262

263-
let gen_client highapi =
263+
let gen_client _config highapi =
264264
List.iter (List.iter print)
265265
(between [""]
266266
[
@@ -352,7 +352,7 @@ let toposort_types highapi types =
352352
assert (List.sort compare result = List.sort compare types) ;
353353
result
354354

355-
let gen_record_deserialization highapi =
355+
let gen_record_deserialization _config highapi =
356356
let gen_of_to_string types =
357357
let gen_string_and_all = function
358358
| DT.Set (DT.Enum (_, elist) as e) ->
@@ -384,7 +384,7 @@ let gen_record_deserialization highapi =
384384
]
385385
)
386386

387-
let gen_client_types highapi =
387+
let gen_client_types _config highapi =
388388
let all_types = all_types_of highapi in
389389
let all_types = add_set_enums all_types in
390390
List.iter (List.iter print)
@@ -440,7 +440,7 @@ let gen_client_types highapi =
440440
]
441441
)
442442

443-
let gen_server highapi =
443+
let gen_server _config highapi =
444444
List.iter (List.iter print)
445445
(between [""]
446446
[
@@ -449,7 +449,7 @@ let gen_server highapi =
449449
]
450450
)
451451

452-
let gen_custom_actions highapi =
452+
let gen_custom_actions _config highapi =
453453
List.iter (List.iter print)
454454
(between [""]
455455
[
@@ -464,13 +464,9 @@ let gen_custom_actions highapi =
464464

465465
open Gen_db_actions
466466

467-
let gen_db_actions highapi =
467+
let gen_db_actions _config highapi =
468468
let highapi_in_db =
469-
Dm_api.filter
470-
(fun obj -> obj.DT.in_database)
471-
(fun _ -> true)
472-
(fun _ -> true)
473-
highapi
469+
Dm_api.filter_by ~obj:(fun obj -> obj.DT.in_database) highapi
474470
in
475471
let all_types_in_db = all_types_of highapi_in_db in
476472
let only_records =
@@ -495,4 +491,5 @@ let gen_db_actions highapi =
495491
@ []
496492
)
497493

498-
let gen_rbac highapi = print (Gen_rbac.gen_permissions_of_static_roles highapi)
494+
let gen_rbac config highapi =
495+
print (Gen_rbac.gen_permissions_of_static_roles config highapi)

0 commit comments

Comments
 (0)