My aggregated monorepo of OCaml code, automaintained
Squashed 'ocaml-openapi/' changes from 3bd8725e..4287b1c8
4287b1c8 Replace hand-written PeerTube library with OpenAPI-generated code
git-subtree-dir: ocaml-openapi
git-subtree-split: 4287b1c86d292a5f5f1ddb470db9d0964745d196
+162
-45
+1
-1
bin/dune
+1
-1
bin/dune
+19
-3
bin/openapi_cli.ml
+19
-3
bin/openapi_cli.ml
···
12
12
close_in ic;
13
13
s
14
14
15
-
(** Parse spec file and run action, handling errors uniformly *)
15
+
(** Check if a file appears to be YAML based on extension or content *)
16
+
let is_yaml_file path content =
17
+
let ext = Filename.extension path |> String.lowercase_ascii in
18
+
ext = ".yaml" || ext = ".yml" ||
19
+
(* Also detect YAML by content if no clear extension *)
20
+
(ext <> ".json" && String.length content > 0 &&
21
+
(content.[0] = '#' || String.sub content 0 (min 7 (String.length content)) = "openapi"))
22
+
23
+
(** Parse spec file and run action, handling errors uniformly.
24
+
Automatically handles both JSON and YAML formats using jsont codecs. *)
16
25
let with_spec spec_path f =
17
26
let spec_content = read_file spec_path in
18
-
match Openapi.Spec.of_string spec_content with
27
+
let result =
28
+
if is_yaml_file spec_path spec_content then begin
29
+
Logs.info (fun m -> m "Detected YAML format");
30
+
Yamlt.decode_string Openapi.Spec.jsont spec_content
31
+
end else
32
+
Openapi.Spec.of_string spec_content
33
+
in
34
+
match result with
19
35
| Error e ->
20
36
Logs.err (fun m -> m "Failed to parse OpenAPI spec: %s" e);
21
37
1
···
81
97
open Cmdliner
82
98
83
99
let spec_path =
84
-
let doc = "Path to the OpenAPI specification file (JSON)." in
100
+
let doc = "Path to the OpenAPI specification file (JSON or YAML)." in
85
101
Arg.(required & pos 0 (some file) None & info [] ~docv:"SPEC" ~doc)
86
102
87
103
let output_dir =
+142
-41
lib/openapi_codegen.ml
+142
-41
lib/openapi_codegen.ml
···
175
175
(** {1 Topological Sort} *)
176
176
177
177
(** Kahn's algorithm for topological sorting.
178
-
Returns nodes in dependency order (dependencies first). *)
178
+
Returns nodes in dependency order (dependencies first).
179
+
Self-dependencies are ignored (they don't affect ordering). *)
179
180
let topological_sort (nodes : string list) (deps : string -> string list) : string list =
180
181
(* Build adjacency list and in-degree map *)
181
182
let nodes_set = StringSet.of_list nodes in
···
185
186
let adj = List.fold_left (fun m node ->
186
187
StringMap.add node [] m
187
188
) StringMap.empty nodes in
188
-
(* Add edges: if A depends on B, add edge B -> A *)
189
+
(* Add edges: if A depends on B, add edge B -> A
190
+
Ignore self-dependencies (node depending on itself) *)
189
191
let (in_degree, adj) = List.fold_left (fun (in_degree, adj) node ->
190
-
let node_deps = deps node |> List.filter (fun d -> StringSet.mem d nodes_set) in
192
+
let node_deps = deps node
193
+
|> List.filter (fun d -> StringSet.mem d nodes_set && d <> node) in
191
194
let in_degree = StringMap.add node (List.length node_deps) in_degree in
192
195
let adj = List.fold_left (fun adj dep ->
193
196
let existing = Option.value ~default:[] (StringMap.find_opt dep adj) in
···
233
236
is_enum : bool;
234
237
enum_variants : (string * string) list; (* ocaml_name, json_value *)
235
238
description : string option;
239
+
is_recursive : bool; (* true if schema references itself *)
236
240
}
237
241
238
242
type operation_info = {
···
336
340
let description = get_string_member "description" field_json in
337
341
{ ocaml_name; json_name = field_name; ocaml_type; base_type; is_optional; is_required; description }
338
342
) schema.properties in
343
+
(* Check if schema references itself *)
344
+
let deps = find_schema_dependencies schema in
345
+
let is_recursive = List.mem name deps in
339
346
{ original_name = name; prefix; suffix; schema; fields; is_enum; enum_variants;
340
-
description = schema.description }
347
+
description = schema.description; is_recursive }
341
348
342
349
(** {1 Operation Processing} *)
343
350
···
440
447
let build_module_tree (schemas : schema_info list) (operations : operation_info list) : module_node * string list =
441
448
let root = empty_node "Root" in
442
449
450
+
(* Build set of known schema names for validation *)
451
+
let known_schemas = StringSet.of_list (List.map (fun s -> s.original_name) schemas) in
452
+
443
453
(* Add schemas to tree and track dependencies *)
444
454
let root = List.fold_left (fun root schema ->
445
455
let prefix_mod = Name.to_module_name schema.prefix in
···
457
467
{ root with children = StringMap.add prefix_mod child root.children }
458
468
) root schemas in
459
469
460
-
(* Add operations to tree based on response type, and track operation dependencies *)
470
+
(* Add operations to tree based on response type, and track operation dependencies.
471
+
Only use response_schema_ref if the schema actually exists in components/schemas. *)
461
472
let root = List.fold_left (fun root op ->
462
-
match op.response_schema_ref with
473
+
(* Check if response schema actually exists *)
474
+
let valid_response_ref = match op.response_schema_ref with
475
+
| Some name when StringSet.mem name known_schemas -> Some name
476
+
| _ -> None
477
+
in
478
+
match valid_response_ref with
463
479
| Some ref_name ->
464
480
let prefix, _ = Name.split_schema_name ref_name in
465
481
let prefix_mod = Name.to_module_name prefix in
···
476
492
} in
477
493
{ root with children = StringMap.add prefix_mod child root.children }
478
494
| None ->
479
-
(* Put in Client module for operations without typed response *)
495
+
(* Put in Client module for operations without valid typed response *)
480
496
let child = match StringMap.find_opt "Client" root.children with
481
497
| Some c -> c
482
498
| None -> empty_node "Client"
···
537
553
in
538
554
Printf.sprintf "%s\n\nval jsont : t Jsont.t" type_def
539
555
540
-
(** Localize an OCaml type string by stripping the current_prefix module *)
541
-
let localize_type ~current_prefix (type_str : string) : string =
542
-
(* Handle patterns like "User.ResponseDto.t" -> "ResponseDto.t" if current_prefix = "User" *)
556
+
(** Localize an OCaml type string by stripping the current_prefix and current_suffix modules.
557
+
When generating code inside a submodule, self-references need to be unqualified. *)
558
+
let localize_type ~current_prefix ~current_suffix (type_str : string) : string =
559
+
(* Handle patterns like "User.ResponseDto.t" -> "ResponseDto.t" if current_prefix = "User"
560
+
And further "ResponseDto.t" -> "t" if current_suffix = "ResponseDto" *)
543
561
let prefix_dot = current_prefix ^ "." in
562
+
let suffix_dot = current_suffix ^ "." in
563
+
let full_path = current_prefix ^ "." ^ current_suffix ^ "." in
544
564
let strip_prefix s =
545
-
if String.length s >= String.length prefix_dot &&
565
+
(* First try to strip full path (Prefix.Suffix.) *)
566
+
if String.length s >= String.length full_path &&
567
+
String.sub s 0 (String.length full_path) = full_path then
568
+
String.sub s (String.length full_path) (String.length s - String.length full_path)
569
+
(* Then try just prefix *)
570
+
else if String.length s >= String.length prefix_dot &&
546
571
String.sub s 0 (String.length prefix_dot) = prefix_dot then
547
-
String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot)
572
+
let rest = String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot) in
573
+
(* If the rest starts with our suffix, strip that too *)
574
+
if String.length rest >= String.length suffix_dot &&
575
+
String.sub rest 0 (String.length suffix_dot) = suffix_dot then
576
+
String.sub rest (String.length suffix_dot) (String.length rest - String.length suffix_dot)
577
+
else rest
548
578
else s
549
579
in
550
580
(* Handle "X list", "X option", and nested combinations *)
···
560
590
in
561
591
localize type_str
562
592
563
-
(** Localize a jsont codec string by stripping the current_prefix module *)
564
-
let rec localize_jsont ~current_prefix (jsont_str : string) : string =
593
+
(** Localize a jsont codec string by stripping the current_prefix and current_suffix modules *)
594
+
let rec localize_jsont ~current_prefix ~current_suffix (jsont_str : string) : string =
565
595
let prefix_dot = current_prefix ^ "." in
566
-
(* Handle patterns like "User.ResponseDto.jsont" -> "ResponseDto.jsont" *)
567
-
(* Also handle "(Jsont.list User.ResponseDto.jsont)" *)
568
-
if String.length jsont_str >= String.length prefix_dot then
569
-
if String.sub jsont_str 0 (String.length prefix_dot) = prefix_dot then
570
-
String.sub jsont_str (String.length prefix_dot) (String.length jsont_str - String.length prefix_dot)
571
-
else if String.length jsont_str > 12 && String.sub jsont_str 0 12 = "(Jsont.list " then
572
-
let inner = String.sub jsont_str 12 (String.length jsont_str - 13) in
573
-
"(Jsont.list " ^ localize_jsont ~current_prefix inner ^ ")"
574
-
else
575
-
jsont_str
596
+
let suffix_dot = current_suffix ^ "." in
597
+
let full_path = current_prefix ^ "." ^ current_suffix ^ "." in
598
+
let strip_prefix s =
599
+
(* First try to strip full path (Prefix.Suffix.) *)
600
+
if String.length s >= String.length full_path &&
601
+
String.sub s 0 (String.length full_path) = full_path then
602
+
String.sub s (String.length full_path) (String.length s - String.length full_path)
603
+
(* Then try just prefix *)
604
+
else if String.length s >= String.length prefix_dot &&
605
+
String.sub s 0 (String.length prefix_dot) = prefix_dot then
606
+
let rest = String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot) in
607
+
(* If the rest starts with our suffix, strip that too *)
608
+
if String.length rest >= String.length suffix_dot &&
609
+
String.sub rest 0 (String.length suffix_dot) = suffix_dot then
610
+
String.sub rest (String.length suffix_dot) (String.length rest - String.length suffix_dot)
611
+
else rest
612
+
else s
613
+
in
614
+
(* Handle patterns like "User.ResponseDto.jsont" -> "ResponseDto.jsont" -> "jsont"
615
+
Also handle "(Jsont.list User.ResponseDto.jsont)" *)
616
+
if String.length jsont_str > 12 && String.sub jsont_str 0 12 = "(Jsont.list " then
617
+
let inner = String.sub jsont_str 12 (String.length jsont_str - 13) in
618
+
"(Jsont.list " ^ localize_jsont ~current_prefix ~current_suffix inner ^ ")"
576
619
else
577
-
jsont_str
620
+
strip_prefix jsont_str
578
621
579
-
let gen_record_impl ~current_prefix (schema : schema_info) : string =
580
-
let loc_type = localize_type ~current_prefix in
581
-
let loc_jsont = localize_jsont ~current_prefix in
622
+
let gen_record_impl ~current_prefix ~current_suffix (schema : schema_info) : string =
623
+
(* For recursive schemas, self-referential fields need to use Jsont.json
624
+
to avoid OCaml's let rec restrictions on non-functional values *)
625
+
let loc_type s =
626
+
let localized = localize_type ~current_prefix ~current_suffix s in
627
+
if schema.is_recursive && localized = "t" then "Jsont.json"
628
+
else if schema.is_recursive && localized = "t list" then "Jsont.json list"
629
+
else if schema.is_recursive && localized = "t option" then "Jsont.json option"
630
+
else if schema.is_recursive && localized = "t list option" then "Jsont.json list option"
631
+
else localized
632
+
in
633
+
let loc_jsont s =
634
+
let localized = localize_jsont ~current_prefix ~current_suffix s in
635
+
if schema.is_recursive && localized = "jsont" then "Jsont.json"
636
+
else if schema.is_recursive && localized = "(Jsont.list jsont)" then
637
+
"(Jsont.list Jsont.json)"
638
+
else localized
639
+
in
582
640
let doc = format_doc schema.description in
583
641
if schema.fields = [] then
584
642
Printf.sprintf "%stype t = Jsont.json\n\nlet jsont = Jsont.json\n\nlet v () = Jsont.Null ((), Jsont.Meta.none)" doc
···
640
698
|> Jsont.Object.finish|}
641
699
type_def v_func accessors schema.original_name make_params v_body jsont_members
642
700
643
-
let gen_record_intf ~current_prefix (schema : schema_info) : string =
644
-
let loc_type = localize_type ~current_prefix in
701
+
let gen_record_intf ~current_prefix ~current_suffix (schema : schema_info) : string =
702
+
(* For recursive schemas, self-referential fields need to use Jsont.json
703
+
to avoid OCaml's let rec restrictions on non-functional values *)
704
+
let loc_type s =
705
+
let localized = localize_type ~current_prefix ~current_suffix s in
706
+
if schema.is_recursive && localized = "t" then "Jsont.json"
707
+
else if schema.is_recursive && localized = "t list" then "Jsont.json list"
708
+
else if schema.is_recursive && localized = "t option" then "Jsont.json option"
709
+
else if schema.is_recursive && localized = "t list option" then "Jsont.json list option"
710
+
else localized
711
+
in
645
712
let doc = format_doc schema.description in
646
713
if schema.fields = [] then
647
714
Printf.sprintf "%stype t\n\nval jsont : t Jsont.t\n\nval v : unit -> t" doc
···
687
754
else
688
755
Printf.sprintf "%s.%s.jsont" prefix_mod suffix_mod
689
756
757
+
(** Check if a schema exists - used to validate refs before generating code *)
758
+
let schema_exists_ref = ref (fun (_ : string) -> true)
759
+
let set_known_schemas (schemas : schema_info list) =
760
+
let known = StringSet.of_list (List.map (fun s -> s.original_name) schemas) in
761
+
schema_exists_ref := (fun name -> StringSet.mem name known)
762
+
690
763
let gen_operation_impl ~current_prefix (op : operation_info) : string =
691
764
let doc = format_doc_block ~summary:op.summary ?description:op.description () in
692
765
let param_docs = String.concat ""
···
694
767
(List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in
695
768
let full_doc = if param_docs = "" then doc
696
769
else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs
697
-
else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in
770
+
else String.sub doc 0 (String.length doc - 3) ^ "\n" ^ param_docs ^ "*)\n" in
771
+
772
+
(* Only use body/response refs if schema actually exists *)
773
+
let valid_body_ref = match op.body_schema_ref with
774
+
| Some name when !schema_exists_ref name -> Some name
775
+
| _ -> None
776
+
in
777
+
let valid_response_ref = match op.response_schema_ref with
778
+
| Some name when !schema_exists_ref name -> Some name
779
+
| _ -> None
780
+
in
698
781
699
782
let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "~%s" n) op.path_params in
700
783
let query_args = List.map (fun (n, _, _, req) ->
···
702
785
) op.query_params in
703
786
(* DELETE and HEAD don't support body in the requests library *)
704
787
let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
705
-
let body_arg = match op.body_schema_ref, method_supports_body with
788
+
let body_arg = match valid_body_ref, method_supports_body with
706
789
| Some _, true -> ["~body"]
707
790
| _ -> []
708
791
in
···
729
812
in
730
813
731
814
let method_lower = String.lowercase_ascii op.method_ in
732
-
let body_codec = match op.body_schema_ref with
815
+
let body_codec = match valid_body_ref with
733
816
| Some name -> format_jsont_ref ~current_prefix name
734
817
| None -> "Jsont.json"
735
818
in
736
819
(* DELETE and HEAD don't support body in the requests library *)
737
-
let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
738
-
let http_call = match op.body_schema_ref, method_supports_body with
820
+
let method_supports_body' = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
821
+
let http_call = match valid_body_ref, method_supports_body' with
739
822
| Some _, true ->
740
823
Printf.sprintf "Requests.%s client.session ~body:(Requests.Body.json (Openapi.Runtime.Json.encode_json %s body)) url"
741
824
method_lower body_codec
···
746
829
Printf.sprintf "Requests.%s client.session url" method_lower
747
830
in
748
831
749
-
let response_codec = match op.response_schema_ref with
832
+
let response_codec = match valid_response_ref with
750
833
| Some name -> format_jsont_ref ~current_prefix name
751
834
| None -> "Jsont.json"
752
835
in
···
799
882
(List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in
800
883
let full_doc = if param_docs = "" then doc
801
884
else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs
802
-
else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in
885
+
else String.sub doc 0 (String.length doc - 3) ^ "\n" ^ param_docs ^ "*)\n" in
886
+
887
+
(* Only use body/response refs if schema actually exists *)
888
+
let valid_body_ref = match op.body_schema_ref with
889
+
| Some name when !schema_exists_ref name -> Some name
890
+
| _ -> None
891
+
in
892
+
let valid_response_ref = match op.response_schema_ref with
893
+
| Some name when !schema_exists_ref name -> Some name
894
+
| _ -> None
895
+
in
803
896
804
897
let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "%s:string" n) op.path_params in
805
898
let query_args = List.map (fun (n, _, _, req) ->
806
899
if req then Printf.sprintf "%s:string" n else Printf.sprintf "?%s:string" n
807
900
) op.query_params in
808
901
let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in
809
-
let body_arg = match op.body_schema_ref, method_supports_body with
902
+
let body_arg = match valid_body_ref, method_supports_body with
810
903
| Some name, true -> [Printf.sprintf "body:%s" (format_type_ref ~current_prefix name)]
811
904
| _ -> []
812
905
in
813
-
let response_type = match op.response_schema_ref with
906
+
let response_type = match valid_response_ref with
814
907
| Some name -> format_type_ref ~current_prefix name
815
908
| None -> "Jsont.json"
816
909
in
···
822
915
823
916
let gen_submodule_impl ~current_prefix (schema : schema_info) : string =
824
917
let suffix_mod = Name.to_module_name schema.suffix in
825
-
let content = if schema.is_enum then gen_enum_impl schema else gen_record_impl ~current_prefix schema in
918
+
let content = if schema.is_enum then gen_enum_impl schema
919
+
else gen_record_impl ~current_prefix ~current_suffix:suffix_mod schema in
826
920
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
827
921
Printf.sprintf "module %s = struct\n%s\nend" suffix_mod indented
828
922
829
923
let gen_submodule_intf ~current_prefix (schema : schema_info) : string =
830
924
let suffix_mod = Name.to_module_name schema.suffix in
831
-
let content = if schema.is_enum then gen_enum_intf schema else gen_record_intf ~current_prefix schema in
925
+
let content = if schema.is_enum then gen_enum_intf schema
926
+
else gen_record_intf ~current_prefix ~current_suffix:suffix_mod schema in
832
927
let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in
833
928
Printf.sprintf "module %s : sig\n%s\nend" suffix_mod indented
834
929
···
895
990
) c.schemas
896
991
in
897
992
993
+
(* Set known schemas for validation during code generation *)
994
+
set_known_schemas schemas;
995
+
898
996
(* Collect operations *)
899
997
let operations = List.concat_map (fun (path, pi) ->
900
998
let ops = [
···
968
1066
| Spec.Value s -> Some (analyze_schema name s)
969
1067
) c.schemas
970
1068
in
1069
+
1070
+
(* Set known schemas for validation during code generation *)
1071
+
set_known_schemas schemas;
971
1072
972
1073
(* Collect operations *)
973
1074
let operations = List.concat_map (fun (path, pi) ->